如何合并多个ppt文件为一个文件「PPTVBA合并多文件」

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