| |
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.
|
| |
' ---------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' ---------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' You may include acknowledgement to the author and a link to this site.
' ----------------------------------------------------------------------
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
|