0

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

扬声器模式

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

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

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

更新 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
4

1 回答 1

0

我怀疑你可以自动化这个。概括地说，使用 VBA，您将：

打开每个演示文稿，然后

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

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

于 2015-02-12T17:04:53.620 回答