PPT97: Sample Code to Reset Custom Animation

MORE INFORMATION

Sub ResetCustomAnimation()
 
   Dim SlideObject As Slide
   Dim ShapeObject As Shape
   Dim TotalChanges As Long
 
   ' Initialize the counters
   TotalChanges = 0
 
   ' Outer loop goes through every slide in the Active presentation
   For Each SlideObject In Application.ActivePresentation.Slides
 
      ' Inner loop goes through every shape in the presentation
      For Each ShapeObject In SlideObject.Shapes
 
         With ShapeObject.AnimationSettings
 
            ' Check if animation settings are used
            If .Animate <> msoFalse Then
               .Animate = msoFalse
               TotalChanges = TotalChanges + 1
            End If
 
         End With
 
      Next ShapeObject
 
   Next SlideObject
 
   ' Check if any objects were changed
   If TotalChanges = 0 Then
 
      MsgBox "No objects had animation events. No changes were made " _
         & "to the presentation.", vbInformation, "No Custom Animations"
 
   Else
 
      ' Set up the message box
      If TotalChanges = 1 Then
         MsgBox "The custom animation settings were successfully reset.", _
            vbInformation, TotalChanges & " Object Reset"
      Else
         MsgBox "The custom animation settings were successfully reset.", _
            vbInformation, TotalChanges & " Objects Reset"
      End If
 
   End If
 
End Sub
				

Microsoft provides examples of Visual Basic for Applications procedures for illustration only, without warranty either expressed or implied, including, but not limited to the implied warranties of merchantability and/or fitness for a particular purpose.

The Visual Basic procedures in this article are provided 'as is' and Microsoft does not guarantee that they can be used in all situations. While Microsoft Support professionals can help explain the functionality of a particular macro, they will not modify these examples to provide added functionality, nor will they help you construct macros to meet your specific needs.

If you have limited programming experience, you may want to consult one of the Microsoft Solution Providers. Solution Providers offer a wide range of fee-based services, including creating custom macros. For more information about Microsoft Solution Providers, call Microsoft Customer Information Service at (800) 426-9400.