Skip to content

Instantly share code, notes, and snippets.

@bhandarisaurav

bhandarisaurav/Merge Multiple PPT VBA

Created September 6, 2018 07:08
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save bhandarisaurav/f0da2bcc7f64919e672ed1ea99f5c47f to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save bhandarisaurav/f0da2bcc7f64919e672ed1ea99f5c47f to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Saurav Bhandari created this gist Sep 6, 2018.
    40 changes: 40 additions & 0 deletions Merge Multiple PPT VBA
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,40 @@
    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 & "\", "*.PPTX", 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