Reputation: 2412
Module LoadDots:
Option Explicit
'this function ensures the self-activating sub will stop if the UF has been closed
Public Function IsLoaded(form As String) As Boolean
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = form Then
IsLoaded = True
Exit Function
End If
Next frm
IsLoaded = False
End Function
Public Sub loadingdots()
If IsLoaded("LoadingInternet") = True Then
If Len(LoadingInternet.DotLabelloading.Caption) = 4 Then
LoadingInternet.DotLabelloading.Caption = "."
DoEvents
Else
LoadingInternet.DotLabelloading.Caption = LoadingInternet.DotLabelloading.Caption & "."
DoEvents
End If
Application.OnTime Now + TimeValue("00:00:01"), "loadingdots"
DoEvents
End If
End Sub
UserForm LoadingInternet
:
Private Sub UserForm_Initialize()
On Error Resume Next
Dim AppXCenter As Long, AppYCenter As Long
AppXCenter = Application.Left + (Application.Width / 2)
AppYCenter = Application.Top + (Application.Height / 2)
With Me
.StartUpPosition = 0
.Top = AppYCenter - (Me.Height / 2)
.Left = AppXCenter - (Me.Width / 2)
End With
subRemoveCloseButton Me
Call loadingdots
End Sub
If I call UserForm like this:
Sub asfafadfdsfdsfdsf()
LoadingInternet.Show vbModeless
End Sub
animation is working.
However in this case I see only one dot (first one). Any ideas why so? Only first dot visible (no animation):
Sub CallCommercialMAIN()
On Error Resume Next
LoadingInternet.Show (vbModeless)
DoEvents
Commercial.Show (vbModeless)
Unload LoadingInternet
End Sub
Here is what I am trying to achieve (used Wingdings font in this example):
Upvotes: 0
Views: 257
Reputation: 42236
Your way of animation looks too complicated for me...
Try the next approach, please:
Sub DotAnimation()
Dim i As Long, frm As Object
Set frm = LoadingInternet
If Not IsLoaded(frm.Name) Then Exit Sub
frm.DotLabelloading.Caption = "."
For i = 1 To 1000
DoEvents
Select Case i
Case 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000
frm.DotLabelloading.Caption = frm.DotLabelloading.Caption & "."
End Select
Next i
End Sub
and IsLoaded
function, modified a little:
Public Function IsLoaded(form As String) As Boolean
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = form Then
If frm.Visible = True Then
IsLoaded = True: Exit Function
End If
End If
Next frm
End Function
If the above Sub does not work, try please, the next one, for a Button click event (from the form in discussion):
Private Sub CommandButtonX_Click()
Dim i As Long
Me.DotLabelloading.Caption = "."
For i = 1 To 1000
DoEvents
Select Case i
Case 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000
Me.DotLabelloading.Caption = Me.DotLabelloading.Caption & "."
End Select
Next i
End Sub
In order to have a continuous animation loop you can use a recursive Sub
like the following one. Of course, you can extend the number of dots per cycle or the dots apparition speed. You can also use an (API) Timer. I've just playing with iteration to check if the animation works:
Private Sub DotAnimation()
Dim i As Long
Static AnimNo As Long
Me.DotLabelloading.Caption = "."
For i = 1 To 1000
DoEvents
Select Case i
Case 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000
Me.DotLabelloading.Caption = Me.DotLabelloading.Caption & "."
End Select
Next i
AnimNo = AnimNo + 1
If AnimNo <= 4 Then
DotAnimation
Else
AnimNo = 0
End If
End Sub
And, instead of the existing code from UserForm_Activate
, you must clear it and place only
Private Sub UserForm_Activate()
DoEvents
DotAnimation
End Sub
I was afraid of a really infinite loop and I limited it to 4 cycles. See the Static AnimNo
variable. After testing, you can remove it, or extend the cycles number to whatever you need...
Theoretically, DoEvents
should allow you to work with the form in parallel...
Upvotes: 1