PPT2000: Sample Code to Assign a Random Animation to all Objects

• Microsoft PowerPoint 2000

SUMMARY

This article contains a sample Microsoft Visual Basic for Applications macro (Sub procedure) that finds all objects in the active presentation and applies an entry custom animation to each one. The macro randomly selects the animation effect to apply to each object.

MORE INFORMATION

Microsoft provides programming examples 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. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft Support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:

http://www.microsoft.com/support/supportnet/overview/overview.asp

Q230746 PPT: Viewer: Presentation Macros Don't Run

Sample Visual Basic Procedure

   Sub AnimationRandomizor()

      Const NumEffects As Byte = 77

      Dim SlideObject As Slide
      Dim ShapeObject As Shape
      Dim HoldRandomValue As Byte
      Dim EffectList(1 To NumEffects) As Long
      Dim TotalChanges As Long

      ' Used for error trapping.
      On Error Resume Next
      Err.Clear

      ' Initialize the counters.
      TotalChanges = 0

      ' Set up the Effect list.
      SetUpEffectList EffectList()

      ' 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

               ' This property must be set to True for any of the
               ' other properties of the AnimationSettings object
               ' to take effect.
               .Animate = msoTrue

               ' Assign a random animation to the object.
               Randomize
               HoldRandomValue = Int((NumEffects * Rnd) + 1)

               ' Assign a random animatation to the object.
               .EntryEffect = EffectList(HoldRandomValue)
               If Err.Number <> 0 Then
                  MsgBox "An error occured. Try runnning the macro " _
                     & "again.", vbCritical, "Error"
               End If

               ' Increment the object count.
               TotalChanges = TotalChanges + 1
            End With

         Next ShapeObject

      Next SlideObject

      ' See whether any objects were changed.
      If TotalChanges = 0 Then
         MsgBox "No objects available. No changes were made " _
            & "to the presentation.", vbInformation, "No Objects"
      Else

         ' Set up the message box.
         If TotalChanges = 1 Then
            MsgBox "One object was given a random custom animation.", _
               vbInformation, "Random Custom Animation"
         Else
            MsgBox "Suscessfully applied a custom animation to all " _
               & "objects.", vbInformation, TotalChanges _
               & " Objects Animated"
         End If

      End If


   End Sub 

   ' Assign effect constants to the List Array.
   Sub SetUpEffectList(ByRef List() As Long)

      ' Appear
      List(1) = ppEffectAppear

      ' Fly Effects
      List(2) = ppEffectFlyFromBottom
      List(3) = ppEffectFlyFromBottomLeft
      List(4) = ppEffectFlyFromBottomRight
      List(5) = ppEffectFlyFromLeft
      List(6) = ppEffectFlyFromRight
      List(7) = ppEffectFlyFromTop
      List(8) = ppEffectFlyFromTopLeft
      List(9) = ppEffectFlyFromTopRight

      ' Blinds Effects
      List(10) = ppEffectBlindsHorizontal
      List(11) = ppEffectBlindsVertical

      ' Box Effects
      List(12) = ppEffectBoxIn
      List(13) = ppEffectBoxOut

      ' Checkerboard Effects
      List(14) = ppEffectCheckerboardAcross
      List(15) = ppEffectCheckerboardDown

      ' Crawl Effects
      List(16) = ppEffectCrawlFromDown
      List(17) = ppEffectCrawlFromLeft
      List(18) = ppEffectCrawlFromRight
      List(19) = ppEffectCrawlFromUp

      ' Dissolve
      List(20) = ppEffectDissolve

      ' Flash Effect
      List(21) = ppEffectFlashOnceFast
      List(22) = ppEffectFlashOnceMedium
      List(23) = ppEffectFlashOnceSlow

      ' Peek Effect
      List(24) = ppEffectPeekFromDown
      List(25) = ppEffectPeekFromLeft
      List(26) = ppEffectPeekFromRight
      List(27) = ppEffectPeekFromUp

    ' Random Effects
      List(28) = ppEffectRandomBarsHorizontal
      List(29) = ppEffectRandomBarsVertical

      ' Spiral
      List(30) = ppEffectSpiral

      ' Split Effects
      List(31) = ppEffectSplitHorizontalIn
      List(32) = ppEffectSplitHorizontalOut
      List(33) = ppEffectSplitVerticalIn
      List(34) = ppEffectSplitVerticalOut

      ' Stretch Effects
      List(35) = ppEffectStretchAcross
      List(36) = ppEffectStretchDown
      List(37) = ppEffectStretchLeft
      List(38) = ppEffectStretchRight
      List(39) = ppEffectStretchUp

      ' Strips Effects
      List(40) = ppEffectStripsDownLeft
      List(41) = ppEffectStripsDownRight
      List(42) = ppEffectStripsLeftDown
      List(43) = ppEffectStripsLeftUp
      List(44) = ppEffectStripsRightDown
      List(45) = ppEffectStripsRightUp
      List(46) = ppEffectStripsUpLeft
      List(47) = ppEffectStripsUpRight

      ' Swivel
      List(48) = ppEffectSwivel

      ' Wipe Effects
      List(49) = ppEffectWipeDown
      List(50) = ppEffectWipeLeft
      List(51) = ppEffectWipeRight
      List(52) = ppEffectWipeUp

      ' Zoom Effects
      List(53) = ppEffectZoomBottom
      List(54) = ppEffectZoomCenter
      List(55) = ppEffectZoomIn
      List(56) = ppEffectZoomInSlightly
      List(57) = ppEffectZoomOut
      List(58) = ppEffectZoomOutSlightly

      ' The following effects may not work.

      ' Uncover Effects
      List(59) = ppEffectUncoverDown
      List(60) = ppEffectUncoverLeft
      List(61) = ppEffectUncoverLeftDown
      List(62) = ppEffectUncoverLeftUp
      List(63) = ppEffectUncoverRight
      List(64) = ppEffectUncoverRightDown
      List(65) = ppEffectUncoverRightUp
      List(66) = ppEffectUncoverUp

      ' Cover Effects
      List(67) = ppEffectCoverDown
      List(68) = ppEffectCoverLeft
      List(69) = ppEffectCoverLeftDown
      List(70) = ppEffectCoverLeftUp
      List(71) = ppEffectCoverRight
      List(72) = ppEffectCoverRightDown
      List(73) = ppEffectCoverRightUp
      List(74) = ppEffectCoverUp

      ' Cut Effects
      List(75) = ppEffectCut
      List(76) = ppEffectCutThroughBlack

      ' Fade
      List(77) = ppEffectFade

   End Sub 

REFERENCES

For more information about using the sample code in this article, please see the following article in the Microsoft Knowledge Base:

Q212536 OFF2000: How to Run Sample Code from Knowledge Base Articles

Additional query words: 9.00 ppt9 vba vbe ppt2k powerpt vba2k ppt9.0 ppt2000 program programming

Keywords : kbcode kbmacro kbprg kbdta kbdtacode kbpptvba
Version : WINDOWS:2000
Platform : WINDOWS
Issue type : kbhowto