TPE

[e-mail]

---

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Automated VBA Solution for PPT 2007 or later

Sub BetterPDFNotes()
    Dim oSl As Slide
    Dim oNewImage As Shape
    Dim oOldImage As Shape

    For Each oSl In ActivePresentation.Slides
        Call oSl.Export(ActivePresentation.Path & "\" & CStr(oSl.SlideIndex) & ".EMF", "EMF")
        Set oOldImage = NotesPageSlidePlaceholder(oSl)
        If Not oOldImage Is Nothing Then
            Set oNewImage = oSl.NotesPage.Shapes.AddPicture( _
                  ActivePresentation.Path & "\" & CStr(oSl.SlideIndex) _
                  & ".EMF", False, True, 0, 0, 200, 200)
            With oNewImage
                .Left = oOldImage.Left
                .Top = oOldImage.Top
                .height = oOldImage.height
                .width = oOldImage.width
                .Tags.Add "TempImage", "YES"
            End With
            ' and after it's all working to perfection
            ' ooldimage.Delete
            ' or just leave the original hidden there behind the EMF
        End If
    Next

End Sub

Function NotesPageSlidePlaceholder(oSl As Slide) As Shape
' Returns the slide placeholder on the notes page
    Dim oSh As Shape
    For Each oSh In oSl.NotesPage.Shapes
        If oSh.Type = msoPlaceholder Then
            If oSh.PlaceholderFormat.Type = ppPlaceholderTitle Then
                Set NotesPageSlidePlaceholder = oSh
                Exit Function
            End If
        End If
    Next
End Function

Automated VBA Solution with improvements for PPT 2010

• Dealing with the fact that PowerPoint 2010 can have multiple notes pages per slide; this works on the first page only.
• Pasting a copy of the original slide as a slide object rather than exporting to EMF and reimporting.
• Adding a line around the slide placeholder.

Sub FixUpNotePageSlideImages()

Dim lOriginalView As Long
Dim oSl As Slide
Dim oSh As Shape
Dim old_placeholder As Shape
Dim oNewSh As Shape

' Store user's original view
lOriginalView = ActiveWindow.ViewType
' Change to notespage view
ActiveWindow.ViewType = ppViewNotesPage

For Each oSl In ActivePresentation.Slides

    oSl.Copy

    ' have we already run this code?  If so, the original
    ' slide image has been replaced and tagged:
    For Each oSh In oSl.NotesPage(1).Shapes
        If Len(oSh.Tags("NEWNOTESPLACEHOLDER")) > 0 Then
            ' found it
            Set old_placeholder = oSh
            Exit For
        End If
    Next

    If old_placeholder Is Nothing Then
        ' no previously replaced shape here, so get the original
        ' slide image placeholder:
        For Each oSh In oSl.NotesPage(1).Shapes
            If oSh.Type = msoPlaceholder Then
                If oSh.PlaceholderFormat.Type = ppPlaceholderTitle Then
                    Set old_placeholder = oSh
                    Exit For
                End If

            End If
        Next
    End If

    With ActiveWindow
        .View.GotoSlide (oSl.SlideIndex)
        .View.Paste
    End With

    With ActiveWindow.Selection.ShapeRange(1)
        .Left = old_placeholder.Left
        .Top = old_placeholder.Top
        .Width = old_placeholder.Width
        .Height = old_placeholder.Height
        .Tags.Add "NEWNOTESPLACEHOLDER", "YES"
        .Line.Weight = 1
    End With

    old_placeholder.Delete
    Set old_placeholder = Nothing

Next

' Restore original view
ActiveWindow.ViewType = lOriginalView

End Sub

---