如何将多个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 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 keIndic.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