Created
July 25, 2018 23:08
-
-
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?
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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