PowerPoint 宏，可将同一目录中的所有 PowerPoint 文件一次性转换为 PDF

Question

我想创建一个 PowerPoint 宏，将同一目录中的所有 PowerPoint 文件一次性转换为 PDF，但它不起作用。

我的要求：

创建满足以下要求的 PowerPoint 宏；您可以修改下面的代码或创建新代码，但请创建一个在 Windows 10 上运行良好的宏。

主要需求规格如下；

• (1) 将同一目录下的所有PowerPoint文件(TEST.ppt)一次性转换为PDF。
• (2) 请将扩展名为 ppt 或 pptx 的文件视为 PowerPoint 文件。
• (3) 请将pdf文件的文件名与原文件名保持一致。 也就是说，如果要转换的PPT文件的文件名为“原文件名.ppt”， 输出PDF文件的文件名应为“原始文件名.pdf”。
• (4) 要保存转换后的 PDF 文件，请在您所在目录的下一级创建一个名为 PDF 的目录并将其存储在此处。

以下是我使用 PowerPoint 的 ExportAsFixedFormat 方法创建的示例，但我在“objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF”行上收到错误：13。

Sub ConvertPowerPointToPDF()
    Dim folderPath As String
    Dim pptFile As String
    Dim pdfFile As String
    Dim pdfFolderPath As String
    Dim objPPT As Object
    Dim objPresentation As Object
    
' Get the current directory path
    folderPath = ActivePresentation.Path

'Create a directory to save the PDF
    pdfFolderPath = folderPath & "\PDF"
    If Dir(pdfFolderPath, vbDirectory) = "" Then
        MkDir pdfFolderPath
    End If
    
' Repeat for all PowerPoint files in the directory
    pptFile = Dir(folderPath & "\*.ppt*")
    
    Do While pptFile <> ""
    
' Exclude current presentation (self)
        If pptFile <> ActivePresentation.Name Then
' Create a PowerPoint application
            Set objPPT = CreateObject("PowerPoint.Application")
            objPPT.Visible = msoTrue 'Uncomment out to display PowerPoint
           
            'Open the presentation
            Set objPresentation = objPPT.Presentations.Open(folderPath & "\" & pptFile)
            
            'Set document properties
            objPresentation.BuiltInDocumentProperties("Title") = objPresentation.BuiltInDocumentProperties("Title")
            objPresentation.BuiltInDocumentProperties("Subject") = objPresentation.BuiltInDocumentProperties("Subject")
            objPresentation.BuiltInDocumentProperties("Author") = objPresentation.BuiltInDocumentProperties("Author")
            objPresentation.BuiltInDocumentProperties("Keywords") = objPresentation.BuiltInDocumentProperties("Keywords")
            objPresentation.BuiltInDocumentProperties("Comments") = objPresentation.BuiltInDocumentProperties("Comments")
            objPresentation.BuiltInDocumentProperties("Last Author") = objPresentation.BuiltInDocumentProperties("Last Author")
            
           'Save as PDF
            pdfFile = pdfFolderPath & "\" & Left(pptFile, Len(pptFile) - InStrRev(pptFile, ".")) & ".pdf"
            objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF
            
           ' Close the presentation
            objPresentation.Close
            
          ' Close the PowerPoint application
            objPPT.Quit
        End If
        
      ' Go to next PowerPoint file
        pptFile = Dir
    Loop
End Sub

Answer 1

• 添加

  PrintRange:=Nothing

  使其正常工作。

objPresentation.ExportAsFixedFormat pdfFile, ppFixedFormatTypePDF, PrintRange:=Nothing