Printing out animated objects from a single slide on multiple pages

Printing out animated objects from a single slide on multiple pages

November 21, 2019

After a PowerPoint presentation is finalized, it's often difficult to prepare a version that can be printed in out in hard copy.  If you have multiple animated objects on a single slide, it won't be possible to prepare a print copy or PDF that shows each object on a separate slide. The below vba code, posted here by by Kallis, can be used to solve this dilemma. 

 

1. In this example we have a slide which has eight different animated objects.   Although it's not the case in this example, animated objects often overlap making it hard to create a hard copy in which each displayed.

 

 

 

2. Press Alt + F11 to enter Visual Basic.  Right click on a presentation in the project panel on the left and insert the below vba code in a new module. 

 

 

 

3. Back in PowerPoint, go to View . . . Macros and then Run 'AddElements'. 

 

 

4. The macro will generate a new slide for each animated object. 

 

 

5.  The original slides will remain, so delete those before printing your hard copy. 

 

Sub AddElements()
 
Dim shp As Shape
 
Dim i As Integer, n As Integer
 
n = ActivePresentation.Slides.Count
 
For i = 1 To n
 
    Dim s As Slide
 
    Set s = ActivePresentation.Slides(i)
 
    s.SlideShowTransition.Hidden = msoTrue
 
  
 
    Dim max As Integer: max = 0
 
    For Each shp In s.Shapes
 
        If shp.AnimationSettings.Animate = msoTrue Then
 
            If shp.AnimationSettings.AnimationOrder > max Then
 
                max = shp.AnimationSettings.AnimationOrder
 
            End If
 
        End If
 
    Next
 
    Dim k As Integer, s2 As Slide
 
    For k = 0 To max
 
        Set s2 = s.Duplicate(1)
 
        s2.SlideShowTransition.Hidden = msoFalse
 
        s2.MoveTo ActivePresentation.Slides.Count
 
      
 
        Dim i2 As Integer
 
        For i2 = s2.Shapes.Count To 1 Step -1
 
            With s2.Shapes(i2)
 
                If .AnimationSettings.Animate = msoTrue Then
 
                    If .AnimationSettings.AnimationOrder > k Then
 
                        .Delete
 
                    Else
 
                        .AnimationSettings.Animate = msoFalse
 
                    End If
 
                End If
 
            End With
 
        Next
 
    Next
 
Next
 
End Sub
 
Sub RemElements()
 
Dim i As Integer, n As Integer
 
Dim s As Slide
 
n = ActivePresentation.Slides.Count
 
For i = n To 1 Step -1
 
    Set s = ActivePresentation.Slides(i)
 
    If s.SlideShowTransition.Hidden = msoTrue Then
 
        s.SlideShowTransition.Hidden = msoFalse
 
    Else
 
        s.Delete
 
    End If
 
Next
 
End Sub

Please reload

Contact Me With Your Litigation Support Questions:

seankevinoshea@hotmail.com

  • Twitter Long Shadow

© 2015 by Sean O'Shea . Proudly created with Wix.com