Navigation Menu

Skip to content

Instantly share code, notes, and snippets.

@ateneva
Created July 25, 2018 23:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ateneva/cf471d8b27b79ac13f47d51346d203f4 to your computer and use it in GitHub Desktop.
Save ateneva/cf471d8b27b79ac13f47d51346d203f4 to your computer and use it in GitHub Desktop.
How do I quickly compile a single PowerPoint presentation from slides saved in multiple files?
Option Explicit
Sub Update_Slide_Data()
Dim Ppres As Presentation
Set Ppres = Presentations("C:\Users\Angelina\Documents\2015_Review.pptm")
Dim location As String
location = "C:\Users\Angelina\Documents\2013_Review.pptx"
Dim PPS As PowerPoint.Slide
Dim Sh As Shape
Dim Str As String
Dim i As Integer
Dim StrNo As Long
Dim ResNo As Long
Dim indicator As String
Dim Data As PowerPoint.Presentation
'***************************************************************************************************************************
indicator = InputBox("Please enter the desired indicator in UPPER case")
For i = 1 To Ppres.Slides.Count
Str = Ppres.Slides(i).Shapes.Title.TextFrame.TextRange
StrNo = InStr(Str, indicator)
Select Case indicator
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case "FLASH"
If StrNo <> 0 Then
Set Data = Presentations.Open("C:\Users\angelina\Documents\Pics.pptm")
Data.Slides.Range(Array(34, 37)).Copy
Ppres.Slides.Paste (i + 1)
Ppres.Save
Data.Close
Call Irrelevant
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case "PROJECTS"
If StrNo <> 0 Then
Set Data = Presentations.Open("C:\Users\angelina\Documents\Projects.pptm")
Data.Slides.Range(Array(2, 3)).Copy
Ppres.Slides.Paste (i + 1)
Ppres.Save
Data.Close
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case "IMPORT"
If StrNo <> 0 Then
Set Data = Presentations.Open("C:\Users\angelina\Documents\Balance.pptm")
Data.Slides.Range(Array(1, 2, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19, 22, 23, 25, 26, 27, 28)).Copy
Ppres.Slides.Paste (i + 1)
Ppres.Save
Data.Close
End If
End Select
Next i
'save as pptx
If Ppres.Slides.Count >= 69 Then Call S
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment