☰

Powerpoint VBA 将 pptx 文件合并为一个

tag-icon • tag-icon vba microsoft-powerpoint
Powerpoint VBA 将 pptx 文件合并为一个

我之前看过类似的帖子，但无法添加更多评论，也无法实施解决方案。所以请不要批评 :) 我基本上需要打开一个空的 pptx 文件，并给出一个文件夹的位置，该文​​件夹包含 20 个其他 pptx 演示文稿（文本、图形、图像），然后将它们（自动）添加到打开的文件中。到目前为止，我尝试过的所有 VBA 对我来说都不起作用，所以如果您可以为像我这样的业余爱好者提供 VBA 示例，请发表评论！

非常感激！

根据这里的一位大师的建议，这是我使用的代码，用我包含的所有 pptx 文件的文件夹替换了 strFPath，这些 pptx 文件我想插入到 MASTER 演示文稿 pptx 文件中，并用文件夹中的一个文件替换了 strSpec，我放置了其他文件，这样它就可以插入了，但没有成功。

Sub Combine_fromFolder() 
    Dim strFPath As String 
    Dim strSpec As String 
    Dim strFileName As String 
    Dim oTarget As Presentation 
    Set oTarget = Application.Presentations.Add(WithWindow:=True) 
    strFPath = "C:\Users\John\Desktop\Test\" ' Edit this
    strSpec = "*.PPTX" 'to include PPT etc use "*.PP*"
    strFileName = Dir$(strFPath & strSpec) 
    While strFileName <> "" 
        oTarget.Slides.InsertFromFile strFileName, oTarget.Slides.Count, 1, 1 
        strFileName = Dir() 
    Wend 
End Sub

答案1

我无法使用您提供的那个。它相当旧，所以可能与 PowerPoint 的较新版本不兼容。

我确实找到了以下 VBAPP工具解决方案 2，可以实现您所描述的功能。唯一的例外是，您不必更改路径，因为此方法使用您要合并的文件所在的文件夹。

此代码中有两个Subs必须一起使用。

  • 打开一个新的演示文稿文件并将其保存到您要合并的所有文件所在的文件夹中（您可以稍后移动它）
  • 将代码粘贴到 VBA 窗口中
  • 运行InsertAllSlides宏，它会将它们组合起来。
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
                .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

相关内容