快速合并多个ppt，可行！

lazlsh

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub testNew()
Dim path, dataPath, inputFileName, outputFileName As String
Dim slideNum As Integer
path = Application.ActivePresentation.path
outputFileName = "合并.pptx"
Dim pptApp, pptInput, pptOutput, newSlide
Set pptApp = New PowerPoint.Application
pptApp.Visible = msoTrue
Set pptOutput = pptApp.Presentations.Open(path & "合并" & outputFileName)
Dim i, j As Integer
Dim inputFileNames() As String
ReDim inputFileNames(1)
dataPath = path & "材料"
inputFileName = Dir(dataPath & "*.ppt*")
Do Until inputFileName = ""
Set pptInput = pptApp.Presentations.Open(dataPath & inputFileName)
Sleep 2000
For j = 1 To pptInput.Slides.Count
pptInput.Slides(j).Copy
Sleep 200
pptOutput.Slides.Paste
Next j
pptInput.Close

inputFileName = Dir
Loop
'pptOutput.Slides(1).Delete
pptOutput.Save
pptOutput.Close
End Sub






[url=]上一封[/url] [url=]下一封[/url]

[url=]« 返回[/url]

以上方法可行，但是我觉得还是有点繁琐。是否有更快捷的方法，都在“材料”文件加内完成，运行代码的ppt也放到“材料”文件夹内。

y93b93

有没有这样的，一般工作时是好多分别做其中的一两页再汇总成一个，如果都按照模板规定做固定页数的情况也好搞，提取文件名对应的第几页就行了。但是实际做的时候可能不按照模板要求做，比如感觉模板中没有体现他所有的工作，就自己加了几页，这样的情况怎么处理？