使用VBA如何将多个PPT汇总到同一个PPT中

如何将多个PPT文件的内容合并为一个PPT
使用VBA 操作PPT是比较少见的，工作中也会有将不同PPT文件合并为同一文件，网上查到的都是使用软件或者使用重用PPT功能, 但是如果文件超多，还是比较麻烦，可以使用VBA 一步就实现这个功能，完成后，可以一下处理成千上万份PPT（有点夸张，时间也会长，但是还是省事）
1.新建两个PPT文件，一个名为Test文件，另一个名为Sumppt, 都另存为TEST.pptm
文件（启动宏的PPT）
2.ALT+F11，模块，将下此文末的代码拷入到所插入模块中后保存
然后将多个PPT放入到跟SumPPT 相同文件夹下的位置
3 开始操作：打开SumPPT ALT+F11 点一下F5 键，出现下面的，然后
点“运行”即可
Sub SUMppt()
Dim MyName, dic, i, MyFileName, FilePath
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
FilePath = Application.ActivePresentation.Path
dic.Add (FilePath & "\"), ""
i = 0
Do While i < dic.Count
ke = dic.keys
MyName = Dir(ke(i), vbDirectory)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(ke(i) & MyName) And vbDirectory) = vbDirectory Then
dic.Add (ke(i) & MyName & "\"), ""
End If
End If
MyName = Dir
Loop
i = i + 1
Loop
For Each ke In dic.keys
MyFileName = Dir(ke & "*.PPTX")
Do While MyFileName <> ""
Set pptInput = Presentations.Open(FilePath & "\" & MyFileName)
Set pptoutput = Presentations.Open(FilePath & "\" & "Test.pptm") ‘ 此文件名可随心情更改
For j = 2 To pptInput.Slides.Count - 1 ' 每一页最后一页不复制，如果需要’复制，请改为1 to pptInput.Slides.Count
pptInput.Slides(j).Copy
If pptoutput.Slides.Count = 0 Then '如果幻灯片是空的
Set newSlide = pptoutput.Slides.Add(1, ppLayoutBlank) '则插入一个空白幻灯片
End If
pptoutput.Slides.Paste (pptoutput.Slides.Count)
Application.ActivePresentation.Save
Next
Application.ActivePresentation.Close
Application.ActivePresentation.Save
Presentations(FilePath & "\" & MyFileName).Close
MyFileName = Dir
Loop
Next
End Sub。