PDA

View Full Version : VBA Split Presentation and save title from slide



ThriveDesign
06-04-2021, 09:36 AM
Hello,
I have long/ large presentations that I split and archive in a slide library. The script I am currently using (John Wilson — pptalchemy.co.uk) creates the individual slides with generic file name with cumulative numbers. I'd like to run one macro to split and name the files with the 'Title' from each slide. I had limited success getting the 'Title' to be pulled from the presentation via – Shape("Title 1"). TextFrame. The files were created but did not split. I have the most basic grasp of VBA so any help would be greatly appreciated.


Sub SplitCards()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
'SAVE A COPY
ActivePresentation.SaveCopyAs (Environ("TEMP") & "\tempfile.pptx")
Set osource = Presentations.Open(Environ("TEMP") & "\tempfile.pptx")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Copy
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
'FOLLOW DESIGN
otarget.Slides(1).Design = osource.Slides(i).Design
otarget.Slides(1).ColorScheme = osource.Slides(i).ColorScheme
osource.Slides(i).Delete
'SAVE THE ONE SLIDE PRES
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\Slide " & CStr(i)) & sExt
otarget.Close
Set otarget = Nothing
Next i
osource.Close
'REMOVE THE TEMP FILE
Kill (Environ("TEMP") & "\tempfile.pptx")
Set osource = Nothing
End Sub

John Wilson
06-05-2021, 08:44 AM
If the Titles are actually in Title Placeholders (ie real Titles)


Sub SplitCards()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
Dim strName As String
'SAVE A COPY
ActivePresentation.SaveCopyAs (Environ("TEMP") & "\tempfile.pptx")
Set osource = Presentations.Open(Environ("TEMP") & "\tempfile.pptx")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Copy
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
'FOLLOW DESIGN
otarget.Slides(1).Design = osource.Slides(i).Design
otarget.Slides(1).ColorScheme = osource.Slides(i).ColorScheme
strName = otarget.Slides(1).Shapes.Title.TextFrame.TextRange
osource.Slides(i).Delete
'SAVE THE ONE SLIDE PRES
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\" & strName & ".pptx")
otarget.Close
Set otarget = Nothing
Next i
osource.Close
'REMOVE THE TEMP FILE
Kill (Environ("TEMP") & "\tempfile.pptx")
Set osource = Nothing
End Sub

ThriveDesign
06-07-2021, 05:38 PM
Thank you. When I run it skips the second slide. How can I fix that?

—Mark

John Wilson
06-08-2021, 02:19 AM
Maybe the second slide has something in the Title that cannot be saved.

e.g. No Title at all
Blank Title
Title has a forbidden character

ThriveDesign
06-08-2021, 08:25 AM
It only has the issue with the one deck. There is something off about that slide. Again, thank you!

John Wilson
06-08-2021, 11:00 AM
Can you post just that slide somewhere (not an image the actual slide)

ThriveDesign
09-06-2022, 01:18 PM
John,
Thanks again. :bow: After running it multiple times, over the year, I notice if nothing (no thumbnail) is selected in the 'Normal View' pane the script runs and exports every slide. If one thumbnail is selected, it skips slide two. I am actually fine with that.

Is there a way to only export/ publish one or selected slides? Maybe using 'Hide Slide'.

—Mark