Converting PowerPoint Flash to Images

J

Jimmy

I found the following code online, it basically iterates through every slide,
take a screen shot, and embed the image in a new PowerPoint. There is one of
two changes I like to make to it

1) The images in the new PowerPoint do not fill up the whole slide/screen.
What must I do to make the image fill up the whole screen?

OR

2) Is there a way to iterate through every flash object in every slide and
embed each individual flash as a separate image in the new slide? I still
want flash objects that were in the same slide in the old PowerPoint to
remain in the same slide in the new PowerPoint, but only is an image format.

Script starts now.....

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
DoEvents
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top