- Details
- Published: Friday, 17 April 2015 13:16
- Hits: 2632
As you've probably noted on the http://www.sheepsqueezers.com website, I've begun to create YouTube videos. Now, in order to piece together these videos, on occasion I need to have individual PowerPoint slides stored as images, like JPGs. This can easily be done by PowerPoint, just click on Save As..., select an image type (like GIF or JPG) in the save as type drop-down box on the Save As dialog, and click on the "Every Slide" button when asked if you want to export all slides or just the current slide.
Easy enough.
But, occasionally, I need to have one image file per animation on a slide. For example, if I have four text boxes, each with the Appear animation, I want four images to be created from that one slide. This is not an option in PowerPoint, so I tried to create a Visual Basic For Applications routine that takes care of that. It seems to work okay except that on occasion a slide is repeated for some strange reason. Also, if you have no animations on a slide at all, no images are created from that slide. Also, if a slide has some objects with animations and some objects with no animations, those with no animations appear on every slide, which is what I want to happen. The code is below. Take note that you will have to change directory and file names on the two lines beginning with ActivePresentation.Slides.Item(I).Export. Let me know if it works for you!
Sub CreateIndivAnimSlides()
On Error Resume Next
'Since the order of the shapes in the Shapes object is not in animation order,
' create an array to hold the proper ordering.
Dim ShapesInAnimOrdr(1 To 10) As Integer
'Create a counter for the slides written to disk
iCnt = 0
'For each slide, perform an Enter and take a snapshot of it
For I = 1 To ActivePresentation.Slides.Count
iShapeCount = ActivePresentation.Slides(I).Shapes.Count
'Make all of the shapes invisible to start except for those shapes with no animation effect
For J = 1 To iShapeCount
ActivePresentation.Slides(I).Shapes.Item(J).Visible = msoFalse
iAnimOrdr = ActivePresentation.Slides(I).Shapes.Item(J).AnimationSettings.AnimationOrder
If Err.Number = 0 Then
ShapesInAnimOrdr(iAnimOrdr) = J
ActivePresentation.Slides(I).Shapes.Item(J).Visible = msoFalse
Else
ActivePresentation.Slides(I).Shapes.Item(J).Visible = msoTrue
End If
Err.Clear
Next
For J = 1 To iShapeCount
'Begin to make each slide visible
iAnimOrdr = ActivePresentation.Slides(I).Shapes.Item(ShapesInAnimOrdr(J)).AnimationSettings.AnimationOrder
If Err.Number = 0 Then
ActivePresentation.Slides(I).Shapes.Item(ShapesInAnimOrdr(J)).Visible = msoTrue
'Increment the slide counter
iCnt = iCnt + 1
'Save this slide to disk as JPG -- YOU NEED TO CHANGE THE FILE LOCATION AND NAME BELOW!!!
If iCnt < 10 Then
ActivePresentation.Slides.Item(I).Export "C:\TEMP\IMAGES\IMAGE_0" & CStr(iCnt) + ".JPG", "JPG", 3000, 2250
Else
ActivePresentation.Slides.Item(I).Export "C:\TEMP\IMAGES\IMAGE_" & CStr(iCnt) + ".JPG", "JPG", 3000, 2250
End If
End If
Err.Clear
DoEvents
Next
Next
End Sub