Маленькое продолжение темы "Аналог Excel-метода "OnTime"" или про многопоточность

Option Explicit
'Модуль для реализации таймеров
'© Антихакер32
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim Dic As Object
 
Sub StartTimer(ClassObj As Object, RaiseObject As Object, ProcName$, Interval&)
    On Error Resume Next: If IsError(ClassObj.gTmr) Then Exit Sub
    If Dic Is Nothing Then Set Dic = CreateObject("scripting.dictionary"): Dic.CompareMode = 1
    EndTimer ClassObj.gTmr
    ClassObj.gTmr = SetTimer(0, 0, Interval, AddressOf TimerProg)
    Dic.Add CStr(ClassObj.gTmr), Array(ClassObj, RaiseObject, ProcName)
End Sub
 
Sub TimerProg(ByVal hWnd As Long, ByVal msg As Long, ByVal idEvent As Long, ByVal TimeSys As Long)
    Dim v: On Error GoTo ERRR
    For Each v In Dic.keys
        If Dic(v)(0) Is Nothing Then
            EndTimer v
        ElseIf idEvent = Dic(v)(0).gTmr Then
            CallByName Dic(v)(1), Dic(v)(2), VbMethod
        End If
    Next: Exit Sub
ERRR:
    Debug.Print "errr"
End Sub
 
Sub EndTimer(ByVal VarTMR&)
    On Error Resume Next
    If VarTMR = 0 Then Exit Sub
    KillTimer 0, VarTMR: Dic.Remove CStr(VarTMR)
End Sub

Option Explicit
'Класс ТАЙМЕР
'© Антихакер32
Public gTmr&
Dim b As Boolean, mEnabled As Boolean
Dim mRaiseObject As Object, mProcName$, mInterval&
 
Public Property Get Interval() As Long
    'Получить значение Interval
    Interval = mInterval
End Property
 
Public Sub StartTimer(RaiseObject As Object, ProcName$, Interval&)
    'Запускает таймер
    'Арг: Объект с вызываемой процедурой // имя процедуры // интервал
    '*Примечание, имя процедуры должно быть объявленно глобально
    Set mRaiseObject = RaiseObject
    mProcName = ProcName
    Me.Interval = Interval
End Sub
 
Public Property Let Interval(ByVal vNewValue As Long)
    'Изменение интервала ускорения таймера этого класса
    If Not (mRaiseObject Is Nothing) And Len(mProcName) And mEnabled Then Else Exit Property
    mInterval = vNewValue: If Not mEnabled Then Exit Property
    mTimer.StartTimer Me, mRaiseObject, mProcName, mInterval
End Property
 
Public Property Let Enabled(ByVal vNewValue As Boolean)
    'Включение или остановка действующего таймера этого класса
    If Not (mRaiseObject Is Nothing) And Len(mProcName) Then Else Exit Property
    mEnabled = vNewValue
    If mEnabled Then
        mTimer.StartTimer Me, mRaiseObject, mProcName, mInterval
    Else: mTimer.EndTimer gTmr
    End If
End Property
 
Public Property Get Enabled() As Boolean
    'Получить значение Enabled
    Enabled = mEnabled
End Property
 
Private Sub Class_Initialize()
    mEnabled = True 'По умолчанию таймер активен
End Sub
 
Private Sub Class_Terminate()
    'Завершение таймера этого класса
    If gTmr Then EndTimer gTmr
End Sub