Printing out animated objects from a single slide on multiple pages
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