用VBA批量合并PPT

VBA脚本

本脚本将文件夹下所有ppt合并到当前ppt中，并在每个ppt前添加包含文件路径的标题页。

Sub InsertAllSlides()
'  Insert all slides from all presentations in the same folder as this one
'  INTO this one; do not attempt to insert THIS file into itself, though.

    Dim vArray() As String
    Dim x As Long
    

    ' Change "*.PPT" to "*.PPTX" or whatever if necessary:
    EnumerateFiles ActivePresentation.Path & "\", "*.PPT", vArray

    With ActivePresentation
        For x = 1 To UBound(vArray)
            If Len(vArray(x)) > 0 Then
                Set TitleSlide = .Slides.Add(.Slides.Count + 1, 11)
                TitleSlide.Shapes.Title.TextFrame.TextRange.Text = vArray(x)
                
                .Slides.InsertFromFile vArray(x), .Slides.Count
            End If
        Next
    End With

End Sub

Sub EnumerateFiles(ByVal sDirectory As String, _
    ByVal sFileSpec As String, _
    ByRef vArray As Variant)
    ' collect all files matching the file spec into vArray, an array of strings

    Dim sTemp As String
    ReDim vArray(1 To 1)

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        ' NOT the "mother ship" ... current presentation
        If sTemp <> ActivePresentation.Name Then
            ReDim Preserve vArray(1 To UBound(vArray) + 1)
            vArray(UBound(vArray)) = sDirectory & sTemp
        End If
        sTemp = Dir$
    Loop

End Sub

使用方法

1. 打开 PowerPoint 应用程序并创建一个新的演示文稿。
2. 打开 Visual Basic 编辑器。可以通过按下 ALT + F11 键或在“开发者”选项卡中选择“Visual Basic”来打开。
3. 在 Visual Basic 编辑器中，选择“插入”菜单，然后选择“模块”以插入一个新的代码模块。
4. 在代码模块中，输入上面的 VBA 脚本。
5. 点击执行（ALT + F8）

参考资料

• Insert all slides from a group of presentations into the current presentation
• ChatGPT