使用方法：

• 打开文件后同时按下alt+F8 ，然后运行宏。
• 宏运行之后会弹出选择框，让你选择ppt文件所在文件夹路径
• 选择好后会自动将此路径下的ppt和pptx文件转换为pdf。
• pdf文件会保存在和ppt文件相同路径下。

xlsm文件

链接：https://netcut.cn/p/4bb9d468636e6126

密码：1234

代码：

Sub ConvertPPTtoPDF()
 Dim fd As FileDialog
 Dim folder As String
 Dim ppt As Presentation
 Dim pdf As String
 Dim pdfx As String

 ' 弹出对话框让用户选择文件夹
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 If fd.Show = -1 Then
   folder = fd.SelectedItems(1)
 Else
   Exit Sub
 End If

 ' 遍历文件夹中的所有文件
 pdf = Dir(folder & "\*.pptx")
 Do While pdf <> ""
   ' 打开pptx文件
   Set ppt = Presentations.Open(folder & "\" & pdf)
   ' 保存为pdf
   ppt.ExportAsFixedFormat folder & "\" & Replace(ppt.Name, ".pptx", ".pdf"), ppFixedFormatTypePDF
   ' 关闭pptx文件
   ppt.Close
   ' 查找下一个pptx文件
   pdf = Dir
 Loop

 ' 重复上述步骤，但这次查找ppt文件
 pdf = Dir(folder & "\*.ppt")
 Do While pdf <> ""
   Set ppt = Presentations.Open(folder & "\" & pdf)
   ppt.ExportAsFixedFormat folder & "\" & Replace(ppt.Name, ".ppt", ".pdf"), ppFixedFormatTypePDF
   ppt.Close
   pdf = Dir
 Loop

 ' 删除所有的pdfx文件 因为使用这个方法会产生没用的pdfx文件，所以需要删除
 pdfx = Dir(folder & "\*.pdfx")
 Do While pdfx <> ""
   Kill folder & "\" & pdfx
   pdfx = Dir
 Loop
End Sub