Here's some code that will pop up multiple stars on a worksheet at one second intervals and then remove them.
Public Sub ShowStars()
Randomize
StarWidth = 50
StarHeight = 50
For i = 1 To 100
TopPos = Rnd() * (ActiveWindow.UsableHeight - StarHeight)
LeftPos = Rnd() * (ActiveWindow.UsableWidth - StarWidth)
Set NewStar = ActiveSheet.Shapes.AddShape _
(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight)
NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56)
Delay 0.01
DoEvents
Next i
Application.Wait Now + TimeValue("00:00:01")
Set myShapes = Worksheets(1).Shapes
For Each shp In myShapes
If Left(shp.Name, 9) = "AutoShape" Then
shp.Delete
Delay 0.01
End If
Next
End Sub
Public Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime< 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub
_________________
George
This message was edited by GeorgeB on 2002-04-02 21:24
Public Sub ShowStars()
Randomize
StarWidth = 50
StarHeight = 50
For i = 1 To 100
TopPos = Rnd() * (ActiveWindow.UsableHeight - StarHeight)
LeftPos = Rnd() * (ActiveWindow.UsableWidth - StarWidth)
Set NewStar = ActiveSheet.Shapes.AddShape _
(msoShape4pointStar, LeftPos, TopPos, StarWidth, StarHeight)
NewStar.Fill.ForeColor.SchemeColor = Int(Rnd() * 56)
Delay 0.01
DoEvents
Next i
Application.Wait Now + TimeValue("00:00:01")
Set myShapes = Worksheets(1).Shapes
For Each shp In myShapes
If Left(shp.Name, 9) = "AutoShape" Then
shp.Delete
Delay 0.01
End If
Next
End Sub
Public Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime< 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub
_________________
George
This message was edited by GeorgeB on 2002-04-02 21:24