Consulting

Results 1 to 6 of 6

Thread: VBA Split Presentation and save title from slide

  1. #1

    VBA Split Presentation and save title from slide

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,999
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    Thank you. When I run it skips the second slide. How can I fix that?

    —Mark

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,999
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    It only has the issue with the one deck. There is something off about that slide. Again, thank you!

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,999
    Location
    Can you post just that slide somewhere (not an image the actual slide)
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •