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