UserForm动画卡住

如何解决UserForm动画卡住

模块载荷点：

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

如果我这样调用UserForm：

Sub asfafadfdsfdsfdsf()

  LoadingInternet.Show vbModeless
  
End Sub

动画有效。

但是在这种情况下，我只能看到一个点（第一个）。任何想法为什么会这样？仅第一个点可见（没有动画）：

Sub CallCommercialMAIN()
    
    On Error Resume Next

    LoadingInternet.Show (vbModeless)
    DoEvents
    
        Commercial.Show (vbModeless)
    
    Unload LoadingInternet

End Sub

---

这是我要实现的目标（在此示例中使用Wingdings字体）：

解决方法

您的动画制作方式对我来说太复杂了...

请尝试下一种方法：

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

和IsLoaded函数，做了一些修改：

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

如果上述Sub不起作用，请尝试下一个，进行Button单击事件（来自讨论中的表单）：

Private Sub CommandButtonX_Click()
 Dim i As Long
 Me.DotLabelloading.Caption = "."
 For i = 1 To 1000
    DoEvents
    Select Case i
        Case 100,1000
            Me.DotLabelloading.Caption = Me.DotLabelloading.Caption & "."
    End Select
 Next i
End Sub

为了具有连续的动画循环，可以使用递归Sub，如下所示。当然，您可以扩展每个周期的点数或点显示速度。您也可以使用（API）计时器。我只是在玩迭代来检查动画是否起作用：

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,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

而且，您必须清除它并只放置{p}来代替UserForm_Activate中的现有代码。

Private Sub UserForm_Activate()
  DoEvents
  DotAnimation
End Sub

我担心真正的无限循环，所以将其限制为4个周期。请参见Static AnimNo变量。测试后，您可以将其删除，或将循环数扩展到所需的任何值...

理论上，DoEvents应该允许您并行处理表单...