如何：工作宏期间进度条上的动画（三点）

Question

我有一个进度条，它以百分比和 'animated' 矩形显示进度。

我知道如何在代码中根据“标记”显示宏的进度，但事实并非如此。在代码中称为“标记”的代码示例，用于更改进度条上的百分比：

Sub progress(pctCompl As Long)

 Progression.Text.Caption = pctCompl & "% Completed"
 Progression.Bar.Width = pctCompl * 2

 DoEvents 'update the userform

End Sub

我想知道是否可以在该进度条上的“请稍候”后面做额外的动画 - 三重 dot:1 点，1 秒停顿，2 点，1 秒停顿，3 点，1 秒停顿。这是该动画的 1 个循环。

我正在尝试做一些事情，主要是实现无限循环或宏，除了三点动画之外什么都不做，这会冻结 Excel 应用程序。

Private Sub UserForm_Activate()

Do Until Progression.Bar.Width = 200
    Progression.Text2.Caption = "Please wait."
    Progression.Repaint
    Application.Wait Now + TimeValue("0:00:01")
    Progression.Text2.Caption = "Please wait.."
    Progression.Repaint
    Application.Wait (Now + TimeValue("0:00:01"))
    Progression.Text2.Caption = "Please wait..."
    Progression.Repaint
    Application.Wait (Now + TimeValue("0:00:01"))
Loop

End Sub

我认为这是提出此类问题的好地方 - 是否可行，如果可行，如何实现？

Answer 1

有时我喜欢在 UserForm 上 'animate' 作为进度指示器的图像，为此我使用 Win API 计时器。下面的代码可能有点 'overkill' 满足您的需求，因为图像更改需要由事件或 Repaint 触发，后者会导致闪烁。我相信 Labels 会在属性值更改后立即更新。如果是这种情况，那么您可以省略下面显示的侦听器 class 并相应地调整代码。

根据上述警告，框架实现可能如下所示：

用户表单代码

注意：我的用户表单有一个开始按钮、一个停止按钮和一个名为 lblWait 的标签。

Option Explicit

Private WithEvents mTimerListener As cTimerListener

Private Sub btnStart_Click()
    HandleStartTimer mTimerListener
End Sub

Private Sub btnStop_Click()
    HandleStopTimer
End Sub

Private Sub mTimerListener_DotCountIncremented(count As Long)
    Me.lblWait = "Please wait" & String(count, ".")
End Sub

Private Sub UserForm_Initialize()
    Set mTimerListener = New cTimerListener
End Sub

Class代码

注意：我将此称为 class cTimerListener。

Option Explicit

Public Event DotCountIncremented(count As Long)

Private mDotCount As Long

Public Property Let DotCount(RHS As Long)
    mDotCount = RHS
    If mDotCount > 3 Then mDotCount = 0
    RaiseEvent DotCountIncremented(mDotCount)
    DoEvents
End Property

Public Property Get DotCount() As Long
    DotCount = mDotCount
End Property

和模块代码

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal HWnd As LongPtr, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As LongPtr) As Long

    Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal HWnd As LongPtr, _
        ByVal nIDEvent As Long) As Long

#Else
    Private Declare Function SetTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) As Long

    Private Declare Function KillTimer Lib "user32" ( _
        ByVal HWnd As Long, _
        ByVal nIDEvent As Long) As Long
#End If

Private mTimerId As Long
Private mTimerListener As cTimerListener

Public Sub HandleStartTimer(timerListener As cTimerListener)
    Set mTimerListener = timerListener
    #If VBA7 Then
        mTimerId = SetTimer(0&, 0&, 0.5 * 1000, AddressOf TimerProc64)
    #Else
        mTimerId = SetTimer(0&, 0&, 0.5 * 1000, AddressOf TimerProc32)
    #End If
End Sub

Public Sub HandleStopTimer()
    KillTimer 0&, mTimerId
End Sub

#If VBA7 Then
    Private Sub TimerProc64(ByVal HWnd As LongPtr, ByVal uMsg As Long, _
        ByVal nIDEvent As Long, ByVal dwTimer As Long)

        TimerProc
    End Sub
#Else
    Private Sub TimerProc32(ByVal HWnd As Long, ByVal uMsg As Long, _
        ByVal nIDEvent As Long, ByVal dwTimer As Long)

        TimerProc
    End Sub
#End If

Private Sub TimerProc()
    If Not mTimerListener Is Nothing Then
        With mTimerListener
            .DotCount = .DotCount + 1
        End With
    End If
End Sub

如何：工作宏期间进度条上的动画（三点）

How to: Animation (triple dot) on progress bar during working macro

excel

vba

progress-bar