Excel 97 - simple animation 1

[modorney]

I have Excel 97. I want to do some simple animation to demonstrate trains on railroad tracks. Basically, black boxes will move from cell to cell.

What I want to do is
1. Recalculate over and over - on 1 second intervals, or more often.
2. Make a cell black or white, depending on the calculation of a formula in that cell (different results, based on the recalculation over and over).

 

[JVFriederick]

This code uses graphic images pasted behind a colored shape. One by one the images appear, simulating movement. At least you can use the time delay equation.

Good luck.



Sub LoopView()
'
Application.ScreenUpdating = True

Dim ImageArray(20) As Variant
ImageArray(1) = "Picture 1"
ImageArray(2) = "Picture 2"
ImageArray(3) = "Picture 3"
ImageArray(4) = "Picture 4"
ImageArray(5) = "Picture 5"
ImageArray(6) = "Picture 6"
ImageArray(7) = "Picture 7"
ImageArray(8) = "Picture 8"
ImageArray(9) = "Picture 9"

For IntI = 1 To 8
ActiveSheet.Shapes(ImageArray(IntI)).Select
Selection.ShapeRange.ZOrder msoBringToFront

EndTime = Now() + 0.01 / 24 / 60 / 60
While Now() < EndTime
Calculate
Wend ' End While loop

ActiveSheet.Shapes(ImageArray(IntI)).Select
Selection.ShapeRange.ZOrder msoSendToBack
ActiveSheet.Shapes(ImageArray(IntI + 1)).Select
Selection.ShapeRange.ZOrder msoBringToFront
Next IntI

EndTime = Now() + 0.01 / 24 / 60 / 60
While Now() < EndTime
Calculate
Wend ' End While loop

ActiveSheet.Shapes(ImageArray(IntI)).Select
Selection.ShapeRange.ZOrder msoSendToBack
Range(&quot;A1&quot.Select


End Sub

 

[modorney]

Thanks!

 

[vbMax]

Try this...
Insert an AutoShape or WordArt object, make sure
that the name of the object is &quot;AutoShape 1&quot;. Then
run the following procedure.


Sub animate()

ActiveSheet.Shapes(&quot;AutoShape 1&quot.Fill.ForeColor.SchemeColor = 10
For cycle = 1 To 4
' Spin...
For n = 1 To 24
ActiveSheet.Shapes(&quot;AutoShape 1&quot.Rotation = _
ActiveSheet.Shapes(&quot;AutoShape 1&quot.Rotation + 15
t = Timer + 0.05
Do While Timer < t
DoEvents
Loop
Next n

' Change color and move...
ActiveSheet.Shapes(&quot;AutoShape 1&quot.Fill.ForeColor.SchemeColor = _
ActiveSheet.Shapes(&quot;AutoShape 1&quot.Fill.ForeColor.SchemeColor + 1
For n = 1 To 100
ActiveSheet.Shapes(&quot;AutoShape 1&quot.IncrementLeft 0.75
t = Timer + 0.01
Do While Timer < t
DoEvents
Loop
Next n
Next cycle

End Sub