快速合并多个ppt，可行！

zzpsx

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也放到“材料”文件夹内。

changhong8

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

excelheth

这个帖子是讲合并的事，要想调整，那在合并后自己随意增减调整都可以。