Solved: Powerpoint animation problem

[dpc]

Hello. I am trying to set up a powerpoint shape to create a 'spirograph' form, and then - after a moment - to have each segment rip away in random directions.

The problem I am encountering is that all the subs seem to run at once and nothing gets shown on the screen.

I'm somewhat new with VBA... What can I do to get around this problem?

Thanks!

Sub CreateSpirograph()
' On Error GoTo AbortNameShape2
Set myDocument = ActivePresentation.Slides(7)
myDocument.Shapes("Hexagon 4").Visible = msoTrue ' show original shape

Dim oShp As Shape
Dim I As Single
'Hexagon 85 is title of shape to modify
Const ROTATION_INCREMENT = 10 'Rotation Increment
Const ROTATION_MAX = 360 'Max rotation
'Select a shape on the slide and then run this

Set oShp = myDocument.Shapes("Hexagon 4")
For I = ROTATION_INCREMENT To ROTATION_MAX Step ROTATION_INCREMENT
With oShp.Duplicate
.Rotation = I
.Left = oShp.Left
.Top = oShp.Top
.Name = "SHP" + CStr(I)
.Visible = msoTrue
End With
Next

' pause
myDocument.Shapes("Hexagon 4").Visible = msoFalse ' hide original shape, others should still be seen

' Now Move
killSomeTime (1)
AddMotionPath
' Now delete when that's done
' killSomeTime (1)
' delShapesNow

End Sub
Private Sub killSomeTime(ByVal inputTime As Integer)
Dim PauseTime, Start
PauseTime = inputTime ' Set duration in seconds
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
' DoEvents ' Yield to other processes.
Loop
End Sub

Sub AddMotionPath()
Const ROTATION_INCREMENT = 10 'Rotation Increment
Const ROTATION_MAX = 360 'Max rotation
Dim shpNew As Shape
Dim effNew As Effect
Dim aniMotion As AnimationBehavior
Dim x, y
' Set shpNew = ActivePresentation.Slides(7).Shapes _
.AddShape(Type:=msoShapeHexagon, Left:=0, _
Top:=0, Width:=100, Height:=100)

For I = ROTATION_INCREMENT To ROTATION_MAX Step ROTATION_INCREMENT

Set shpNew = ActivePresentation.Slides(7).Shapes("SHP" + CStr(I))
Set effNew = ActivePresentation.Slides(7).TimeLine.MainSequence _
.AddEffect(Shape:=shpNew, effectId:=msoAnimEffectCustom, _
Trigger:=msoAnimTriggerWithPrevious)
Set aniMotion = effNew.Behaviors.Add(msoAnimTypeMotion)

x = Int((1024 - 1 + 1) * Rnd + 1)
y = Int((768 - 1 + 1) * Rnd + 1)

If Int((10) * Rnd + 1) > 4 Then
x = -x
End If

If Int((10) * Rnd + 1) > 4 Then
y = -y
End If


' oShp.Name = ("SHP" + CStr(I)) ' "WITH object type must be user-defined, object, or varient"


' With ActivePresentation.Slides(7).Shapes("SHP" + CStr(I)) ' undefined names

' .FromX = oShp.Left
' .FromY = oShp.Top
' .Rotation = I
' .ToX = x
' .ToY = y

With aniMotion.MotionEffect
.FromX = 0
.FromY = 0
.ToX = x
.ToY = y
End With

' End With
Next


End Sub
Sub delShapesNow()
' On Error GoTo AbortNameShape2
Dim oShp As Shape
Dim I As Single
'Hexagon 85 is title of shape to modify
Const ROTATION_INCREMENT = 10 'Rotation Increment
Const ROTATION_MAX = 360 'Max rotation
'Select a shape on the slide and then run this

For I = ROTATION_INCREMENT To ROTATION_MAX Step ROTATION_INCREMENT
ActivePresentation.Slides(7).Shapes("SHP" + CStr(I)).Delete
Next
End Sub

[dpc]

I figured out the problem ('doEvents' was remarked out).

But I have a secondary problem: When the spirograph sub is ran, the for/next loop finishes before the completed design of the shape segments is shown.

Is it possible to show each new segment appear during the for/next loop's execution? That would look more fluid to the viewer...

Thanks much!

[dpc]

The timing mechanism being called either won't run (if 0.5 seconds is indicated), or runs way too slowly (1.0+ seconds being indicated).

It's not essential to my tasks, so I moved on to more critical functionality.