animated stautus bar

[seacrest]

I copied the following code from this site It works great but it runs continuously I would like it to run for about 10 seconds on
opening my spreadsheet. Can you help?




Public Sub animatestatusbar()

Dim sText As String
Dim iLength As Integer
Dim bForwards As Boolean


sText = "Hello"
iLength = Len(sText) + 1
bForwards = True

Do
DoEvents

If bForwards Then
sText = " " & sText
Else
sText = Right(sText, Len(sText) - 1)
End If

If Len(sText) > 30 Then
bForwards = False
End If

If Len(sText) < iLength Then
bForwards = True
End If
Sleep 300
Application.StatusBar = sText
Loop

End Sub

 

[seacrest]

sorry i left this off the very top



Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

 

[seacrest]

[No message]

 

[s-o-s]

The following amended will now work for approx 10 seconds.

Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)


Public Sub animatestatusbar()

Dim sText As String
Dim iLength As Integer
Dim bForwards As Boolean


sText = "Hello"
iLength = Len(sText) + 1
bForwards = True
rep = 0

Do
DoEvents
rep = rep + 1
If bForwards Then
sText = " " & sText
Else
sText = Right(sText, Len(sText) - 1)
End If

If Len(sText) > 30 Then
bForwards = False
End If

If Len(sText) < iLength Then
bForwards = True
End If
Sleep 150
Application.StatusBar = sText
If rep > 50 Then GoTo break
Loop
break:
Application.StatusBar = ""
End Sub