Question

所以我有大约1000个powerpoint幻灯片（* .pps）以扬声器模式运行，我们将其用作文档。

Speaker mode

我想禁止用户手动向前和向后滚动，只使用ESC键关闭幻灯片。这是kiosk模式非常适合的地方。所以我需要将所有这些文件转换为kiosk模式，我宁愿不要手动完成。我已经检查过一个解决方案，我发现它只是一个旧的PowerPoint Viewer命令“/ 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

找到的第一个文件工作正常，第二个文件给我以下错误消息： Error message
调试器突出显示：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幻灯片到自助服务终端

1 个答案: