OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Create a presentation of slide images (w/o using API  or exporting & re-inserting images)

 

You may want to create a presentation which consists of images of the slides themselves. This would involve either copying the slide to the clipboard and pasting a meta file using Windows API call or exporting the slides as images and then re-inserting them into the slides.

Let us look at a third option - one that's makes use of the slide image already available on the notes pages. The image is contained in the  Title placeholder of the notes page. The Notes pages does have a  placeholder collection thru which one can enumerate obtain reference to the Title placeholder. If you get nothing it implies that the user has deleted it from the layout. No problem there, just add the placeholder shape, copy it and delete it. Now, you can paste this copied shape as an image onto the slide.

The task of resizing the slide images to full size has been left as an exercise.

 

Sub PasteSlideImages()
Dim Counter As Integer
Dim oPresA As Presentation
Dim oPresB As Presentation
Dim oSlide As Slide
Dim oShp As Shape
Set oPresA = ActivePresentation

' Create a new presentation
Set oPresB = Presentations.Add
For Counter = 1 To oPresA.Slides.Count
    ' Add a blank slide to insert image of source slide
    oPresB.Slides.Add oPresB.Slides.Count + 1, ppLayoutBlank
    ' Activate the source presentation and move to the source slide
    oPresA.Windows(1).Activate
    ActiveWindow.View.GotoSlide Counter
    Set oSlide = oPresA.Slides(Counter)

    ' Switch to Notes view to obtain the shape reference of
    ' the Title shape i.e. the slide image on the notes page
    ActiveWindow.ViewType = ppViewNotesPage
    On Error Resume Next
    Set oShp = GetNotesTitle(oSlide)

    ' If shape reference wasn't obtained it implies that the,
    ' image may have to deleted or not included in the notes layout

    If Not oShp Is Nothing Then
        oShp.Copy
        oDoEvents
    Else
        ' If the image is not present, we add title placeholder
        ' to copy the image and then delete it.

        oSlide.NotesPage.Shapes.AddPlaceholder (ppPlaceholderTitle)
        Set oShp = GetNotesTitle(oSlide)
        oShp.Copy
        DoEvents
        oShp.Delete
    End If
    ActiveWindow.ViewType = ppViewSlide
    oPresB.Windows(1).Activate
    ActiveWindow.View.GotoSlide oPresB.Slides.Count
    ActiveWindow.ViewType = ppViewSlide
    ActiveWindow.View.Paste
Next Counter

Set oShp = Nothing
Set oSlide = Nothing
Set oPresA = Nothing
Set oPresB = Nothing
End Sub

Function GetNotesTitle(oSld As Slide, Optional oPHType As Integer = ppPlaceholderTitle) As Shape
Dim oShp As Shape
On Error GoTo ErrGetNotesTitle
For Each oShp In oSld.NotesPage.Shapes.Placeholders
    If oShp.PlaceholderFormat.Type = oPHType Then
        Set GetNotesTitle = oShp
        Exit Function
    End If
Next oShp
ErrGetNotesTitle:
Set GetNotesTitle = Nothing
End Function

 


Copyright 1999-2022 (c) Shyam Pillai. All rights reserved.