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

如何将多个PPT文件的内容合并为一个PPT 使用VBA 操作PPT是比较少见的， 工作中也会有将不同PPT文件合并为同一文件，网上查到的都是使用软件或者使用重用PPT功能, 但是如果文件超多，还是比较麻烦，可以使用VBA 一步就实现这个功能， 完成后，可以一下处理成千上万份PPT（有点夸张，时间也会长， 但是还是省事） 新建两个PPT文件，一个名为Test文件，另一个名为Sumppt, 都另存为TEST.pptm 文件（ 启动宏的PPT） 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