目录
一、思路
1.获取文件列表
2.遍历文件列表中的文件
3.调用相应过程进生成PDF
4.完成
二、示例代码
三、补充
一、思路
1.获取文件列表
通过fso对象逐层获取主文件夹下的各层子文件夹，存入一个数组
然后遍历这个数组，获取每个文件夹下的PPT文件，存入另一个数组drr
2.遍历文件列表中的文件
遍历前面的drr，同时把拼接出导出的PDF文件的路径fName
用presentations.open()方法打开遍历的PPT文件，赋值给prs对象
3.调用相应过程进生成PDF
将打开的文件prs对象和PDF路径fName传递给另存、导出或打印的过程，生成PDF
4.完成
完成，关闭打开的DPF文件prs
二、示例代码
Rem 此处以下为主程序
Sub 批量获取文件路径()
Dim fd As FileDialog
Dim fso As Object
Dim arr() '存储所有word文件路径
Dim brr() '存储每次遍历到的文件夹的子文件夹
Dim crr() '存储所有文件夹
Dim drr() '存储所有Word文件路径
Dim myFolder As Object
Dim subFolder As Variant
Dim i As Long
Dim j As Long
Dim m As Long
Dim myFile As Object
Dim 后缀 As String
Dim t0 As Single
Dim cType As Integer
Dim fName As String
Dim prs As Presentation
t0 = Timer
i = 0: j = 0: m = 0
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set fso = CreateObject("Scripting.FileSystemObject")
With fd
.Title = "选择主文件夹"
If .Show Then
i = i + 1
ReDim Preserve crr(1 To i)
crr(i) = .SelectedItems(1)
arr = crr
On Error Resume Next
Do While Err.Number = 0
For j = LBound(arr) To UBound(arr)
Set myFolder = fso.GetFolder(arr(j))
If myFolder.subFolders.Count > 0 Then
For Each subFolder In myFolder.subFolders
i = i + 1
ReDim Preserve crr(1 To i)
crr(i) = subFolder.Path
m = m + 1
ReDim Preserve brr(1 To m)
brr(m) = subFolder.Path
Next
End If
Next
m = 0
arr = brr
Erase brr
Loop
On Error GoTo 0
i = 0
For j = LBound(crr) To UBound(crr)
' Debug.Print j, crr(j)
Set myFolder = fso.GetFolder(crr(j))
For Each myFile In myFolder.Files
后缀 = fso.GetExtensionName(myFile.Path)
If 后缀 Like "ppt*" And Not myFile.Path Like "*~$*" Then
i = i + 1
ReDim Preserve drr(1 To i)
drr(i) = myFile.Path
End If
Next
Next
cType = Int(Trim(InputBox("请输入生成PDF的方式：" & vbCrLf & "1：另存" & vbCrLf & "2：导出" & vbCrLf & "3：打印", "方式选择", 2)))
Do While cType < 1 Or cType > 3
cType = Int(Trim(InputBox("输入错误。请重新输入生成PDF的方式：" & vbCrLf & "1：另存" & vbCrLf & "2：导出" & vbCrLf & "3：打印", "方式选择", 2)))
Loop
'Application.ScreenUpdating = False
For j = LBound(drr) To UBound(drr)
Rem 此处以下为调用的处理过程
fName = Replace(drr(j), fso.GetExtensionName(drr(j)), "PDF")
Set prs = Presentations.Open(drr(j))
Select Case cType
Case 1
Call PPT另存PDF(prs, fName)
Case 2
Call PPT导出PDF(prs, fName)
Case 3
Call PPT打印PDF(prs, fName)
End Select
prs.Close
Rem 此处以上为调用的处理过程
Debug.Print Format(j, String(Len(CStr(UBound(drr))), "0")), drr(j), "打印完成"
Next
'Application.ScreenUpdating = False
End If
End With
Set fd = Nothing
Set fso = Nothing
Set myFolder = Nothing
Set prs = Nothing
Debug.Print "完成 共打印了" & UBound(drr) & "个文件 用时" & Timer - t0 & "秒"
End Sub
Rem 此处以下为3种生成PDF的不同方式
Sub PPT打印PDF(prs As Presentation, fName As String)
With prs.PrintOptions
.Collate = msoTrue
.FitToPage = msoTrue
.FrameSlides = msoCTrue '加边框
' .OutputType = ppPrintOutputSixSlideHandouts
.OutputType = ppPrintOutputSlides
.PrintColorType = ppPrintColor
End With
prs.PrintOut printtofile: fName
End Sub
Sub PPT导出PDF(prs As Presentation, fName As String)
prs.ExportAsFixedFormat2 fName, ppFixedFormatTypePDF, ppFixedFormatIntentPrint, True, _
ppPrintHandoutHorizontalFirst, ppPrintOutputSlides, includedocproperties:=True
End Sub
Sub PPT另存PDF(prs As Presentation, fName As String)
prs.SaveAs fName, ppSaveAsPDF, msoTriStateMixed
End Sub三、补充
关于具体的操作方法和Word批量导出PDF的方法，请关注我之前的专栏文章
守候：Word VBA：批量转PDF且保留书签https://zhuanlan.zhihu.com/p/540316455文章来源：https://www.toymoban.com/news/detail-445483.html
有其他任何VBA/办公自动化的问题也可以提问或者浏览我的主页的回答和文章。文章来源地址https://www.toymoban.com/news/detail-445483.html
到了这里，关于PPT VBA：批量转PDF的文章就介绍完了。如果您还想了解更多内容，请在右上角搜索TOY模板网以前的文章或继续浏览下面的相关文章，希望大家以后多多支持TOY模板网！
