Sub 合并PPT()
Dim t0 As Single: t0 = Timer
Dim fdlog As FileDialog
Dim prs As Presentation
Dim prs1 As Presentation
Dim sld As Slide
Dim file
Dim i As Integer
Set prs = Presentations.Add
Set fdlog = Application.FileDialog(msoFileDialogFilePicker)
With fdlog
.AllowMultiSelect = True
With .Filters
.Clear
.Add "PPT文件", "*.ppt*;*.ppa*;*.pps*", 1
.Add "所有文件", "*.*", 2
End With
If .Show Then
i = 0
For Each file In .SelectedItems
Set prs1 = Presentations.Open(CStr(file))
For Each sld In prs1.Slides
sld.Copy
prs.Slides.Paste prs.Slides.Count + 1
Next
prs1.Close
i = i + 1
Next
End If
End With
Set fdlog = Nothing
Set prs = Nothing
Set prs1 = Nothing
If i > 0 Then
MsgBox Format(i, "完成,共合并了0个文件。") & Format(Timer - t0, "用时0.000秒。")
End If
End Sub
PPT VBA:多文件合并代码
最新推荐文章于 2024-04-28 19:57:51 发布