VBA PowerPoint: объединение файлов pptx в один

Я видел подобный пост раньше, но не смог добавить больше комментариев и реализовать решение. Так что, пожалуйста, не критикуйте 🙂 Мне нужно открыть пустой файл pptx и указать путь к папке, которая содержит, скажем, 20 других презентаций pptx (текст, графики, изображения), и автоматически добавить их в открытый файл. Все VBA, которые я пробовал до сих пор, не работают для меня, поэтому, пожалуйста, добавьте комментарии, если сможете предоставить пример VBA для таких amateur’ов, как я!

Большое спасибо!

Как посоветовал один из мастеров здесь, вот код, который я использовал и заменил strFPath на папку, в которой находятся все pptx файлы, которые я хотел вставить в мастер-презентацию 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\" ' Измените это
    strSpec = "*.PPTX" 'для включения PPT и т.д. используйте "*.PP*"
    strFileName = Dir$(strFPath & strSpec) 
    While strFileName <> "" 
        oTarget.Slides.InsertFromFile strFileName, oTarget.Slides.Count, 1, 1 
        strFileName = Dir() 
    Wend 
End Sub 

Мне не удалось заставить работать тот, что у вас есть. Он довольно старый, так что, возможно, он несовместим с более поздними версиями PowerPoint.

Я нашел следующий VBA на PPTools, Решение 2, который позволяет выполнить то, что вы описали. Единственное исключение — вам не нужно изменять путь, потому что этот код использует папку, в которой находятся файлы, которые вы хотите объединить.

В этом коде есть два Subs, которые необходимо использовать вместе.

• Откройте новый файл презентации и сохраните его в папке, где находятся все файлы, которые вы хотите объединить (вы можете переместить его позже)
• Вставьте код в окно VBA
• Запустите макрос InsertAllSlides, и он объединит их.

Sub InsertAllSlides()
'  Вставить все слайды из всех презентаций в той же папке, что и эта
'  В ЭТУ; не пытайтесь вставить ЭТУ презентацию в саму себя.

    Dim vArray() As String
    Dim x As Long

    ' Измените "*.PPT" на "*.PPTX" или на что-то другое, если необходимо:
    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)
    ' собрать все файлы, подходящие под спецификацию файлов, в vArray, массив строк

    Dim sTemp As String
    ReDim vArray(1 To 1)

    sTemp = Dir$(sDirectory & sFileSpec)
    Do While Len(sTemp) > 0
        ' НЕ "материнское судно" ... текущая презентация
        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