将 powerpoint 幻灯片批量转换为 kiosk

Question

所以我有大约 1000 个 powerpoint 幻灯片 (*.pps) 运行我们将其用作文档。

我想禁止用户手动向前和向后滚动并且只能使用 ESC 键关闭幻灯片。这就是 kiosk 模式非常适合的地方。所以我需要将所有这些文件转换为 kiosk 模式，我宁愿不手动进行。我已经检查了解决方案，我发现的只是一个旧的 PowerPoint 查看器命令“/K”。 http://www.pptfaq.com/FAQ00528_Command_Line_Switches_-_PowerPoint_and_PowerPoint_Viewers.htm

另一个选项是使用 PowerPoint Viewer，但由于默认情况下无法在 kiosk 模式下打开幻灯片，此选项也失败。

我真的希望有人知道解决方案或者可以指导我正确的方向。

更新 1：

@Steve Rindsberg 感谢您的帮助，我已将您的代码与此处找到的代码合并：http://www.pptalchemy.co.uk/file_scripting.html

现在看起来像这样：

Sub getfiles(strpath As String)
    Dim PPT As PowerPoint.Application
    Dim fso As Object
    Dim objfolder As Object
    Dim objfile As Object
    Dim opres As PowerPoint.Presentation
    Dim strSuffix As String
    Dim objsub As Object
    strSuffix = "*.pp*" 'File suffix note * is wild card
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfolder = fso.GetFolder(strpath)
     ' main folder
    For Each objfile In objfolder.Files
        If objfile.Name Like strSuffix Then
            Set PPT = New PowerPoint.Application
            Set opres = PPT.Presentations.Open(objfile.Path, msoFalse)
             If objfile.Name Like "*.pps*" Then
                opres.NewWindow
             End If

            opres.SlideShowSettings.ShowType = ppShowTypeKiosk
            opres.Save
            opres.Close
            PPT.Quit
        End If
    Next objfile
     ' Sub Folders
    For Each objsub In objfolder.SubFolders
        Call getfiles(objsub.Path)
    Next objsub

    Set objsub = Nothing
    Set objfile = Nothing
    Set objfolder = Nothing
    Set opres = Nothing
    Set PPT = Nothing
End Sub

找到的第一个文件工作正常，第二个文件给我以下错误消息：
调试器突出显示行：opres.SlideShowSettings.ShowType = ppShowTypeKiosk。我知道问题出在 opres 部分，只是似乎无法弄清楚解决方案是什么。

更新 2： 想通了：D。我已经建立了一个声明来查看 Powerpoint.Application 是否已经存在并且现在它可以完美地工作。尽管总是欢迎提出建议，但对我来说，这个问题现在已经结束了。感谢帮助

我的最终代码：

Sub getfiles(strpath As String)
    Dim PPT As PowerPoint.Application
    Dim fso As Object
    Dim objfolder As Object
    Dim objfile As Object
    Dim opres As PowerPoint.Presentation
    Dim strSuffix As String
    Dim objsub As Object
    strSuffix = "*.pp*" 'File suffix note * is wild card
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfolder = fso.GetFolder(strpath)
     ' main folder
    For Each objfile In objfolder.Files
        If objfile.Name Like strSuffix Then
            If PPT Is Nothing Then
                Set PPT = New PowerPoint.Application
            Else
            End If
            Set opres = PPT.Presentations.Open(objfile.Path, msoFalse)
             If objfile.Name Like "*.pps*" Then
                opres.NewWindow
             End If

            opres.SlideShowSettings.ShowType = ppShowTypeKiosk
            opres.Save
            opres.Close

        End If
    Next objfile
     ' Sub Folders
    For Each objsub In objfolder.SubFolders
        Call getfiles(objsub.Path)
    Next objsub

    Set objsub = Nothing
    Set objfile = Nothing
    Set objfolder = Nothing
    Set opres = Nothing
    Set PPT = Nothing
End Sub

Answer 1

我怀疑你可以自动执行此操作。概括地说，使用 VBA，您将：

打开每个演示文稿，然后

With ActivePresentation.SlideShowSettings
    .ShowType = ppShowTypeKiosk
End With
With ActivePresentation
   .Save
   .Close
End With

如果您在外部自动化 PPT，ppShowTypeKiosk = 3

将 powerpoint 幻灯片批量转换为 kiosk

Batch convert powerpoint slideshows to kiosk

powerpoint

cmd

batch-file

bulk

powerpoint-2010