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個(gè)文件。") & Format(Timer - t0, "用時(shí)0.000秒。")

? ? End If

End Sub