Как: анимация (тройная точка) на индикаторе выполнения во время работы макроса

Question

У меня есть индикатор выполнения, который показывает прогресс в процентах и ​​на анимированном прямоугольнике.

Я знаю, как показать прогресс макроса на основе «отметок» в коде, это не так.Пример кода, который в коде обозначается как «отметка» для изменения процента на индикаторе выполнения:

Sub progress(pctCompl As Long)

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

 DoEvents 'update the userform

End Sub

Интересно, возможно ли сделать дополнительную анимацию за «Пожалуйста, подождите» на индикаторе выполнения - тройная точка: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 в качестве индикатора прогресса, и для этого я использую таймер Win API.Код ниже может быть немного «излишним» для ваших нужд, так как изменения изображения должны быть вызваны либо событием, либо Repaint, последнее из которых может вызвать мерцание.Я считаю, Labels обновляется, как только изменяется значение свойства.Если это так, то вы могли бы опустить класс слушателя, показанный ниже, и соответствующим образом скорректировать код.

С приведенным выше предупреждением реализация скелета может выглядеть следующим образом:

Userformкод

Примечание: моя пользовательская форма имеет кнопку запуска, кнопку остановки и одну метку, называемую 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

Код класса

Примечание. Я назвал этот класс 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