looping at regular interval

  • Thread starter Thread starter grime
  • Start date Start date
G

grime

I am trying to create a "marquee" effect by looping through 3 fill
effects.

It does what I'm going after, but only performs the fill effects once,
then stops. I am trying to get it to repeat from the beginning after
the 3rd fill effect.


Code:
--------------------
Dim iCount As Integer
Sub ColorChange()
Dim dTime As Date
dTime = Now
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange"
iCount = iCount + 1
If iCount = 1 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 2 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 3 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 13
End If
If iCount = 3 Then
iCount = 0
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange", , False
End If
End Sub
 
remove the line that cancels the Ontime (move it to another routine). Make
dtime a public variable or you won't be able to stop it without closing
Excel.
 
Dim iCount As Integer
Dim dTime as Date
Sub ColorChange()
dTime = Now
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange"
iCount = iCount + 1
If iCount = 1 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 2 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 13
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 8
End If
If iCount = 3 Then
ActiveSheet.Shapes("Group 1").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 2").Fill.ForeColor.SchemeColor = 8
ActiveSheet.Shapes("Group 3").Fill.ForeColor.SchemeColor = 13
End If
If iCount = 3 Then
iCount = 0
End If
End Sub

Sub StopAnimation()
Application.OnTime dTime + TimeValue("00:00:01"), "ColorChange", , False
End Sub
 
Back
Top