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