VBA 定时器类

Question

所以我正在尝试在 VBA 中编写一个计时器类，除了一件事之外，一切似乎都很好。

当我调用 Application.OnTime我需要提供循环函数的名称，并且该函数位于我的计时器类中，因此我不知道如何访问它。

我尝试将计时器实例名称传递给计时器以从中调用函数，如下所示:

Application.OnTime pNextTick, pName & ".RestartInterval"

其中 pName 是外部计时器实例的名称:

Set AutoUpdater = New C_Timer
AutoUpdater.Name = "AutoUpdater"

但无论我做什么，我都会收到以下错误:

Cannot run the macro "blablablablablabla.xlsm'!AutoUpdater.RestartInterval'. the macro may not be available in this workbook or all macros may be disabled.

在我的情况下，宏没有被禁用，所以我需要一些帮助......

这是我的 C_Timer到目前为止的类(class):

'test module
Public Sub test()
    Set AutoUpdater = New C_Timer
    AutoUpdater.Name = "AutoUpdater"
    AutoUpdater.Interval = "00.00.5"
    AutoUpdater.WhatToRun = "DoSomething"
    AutoUpdater.StartTimer
End Sub

Function DoSomething()
    MsgBox "sdoiigsligsdgoidjh"
End Function

'C_Timer class

Private pWhatToRun As String
Private pInterval As String
Private pName As String
Private pRunning As Boolean
Private pNextTick

Private Function RestartInterval()
    If pWhatToRun <> "" Then
        Application.Run pWhatToRun
        pNextTick = Now + TimeValue(pInterval)
        Application.OnTime pNextTick, pName & ".RestartInterval"
    End If
End Function


Public Function StartTimer() As Boolean
On Error GoTo hell

    If TimeValue(pInterval) > TimeValue("00.00.00") And pName <> "" And pRunning <> True Then
        pNextTick = Now + TimeValue(pInterval)
        Application.OnTime pNextTick, pName & ".RestartInterval"
        pRunning = True
    Else
        GoTo hell
    End If
    Exit Function
hell:
        pRunning = False
        M_Settings.SetStatus "Failed to update"
End Function

Public Function StopTimer() As Boolean
On Error GoTo hell
    If pRunning = True Then
        Application.OnTime pNextTick, "RestartInterval", , False
        pRunning = False
    Else
        GoTo hell
    End If
    Exit Function
hell:
        
End Function

Public Property Get WhatToRun() As String
    WhatToRun = pWhatToRun
End Property
Public Property Let WhatToRun(Value As String)
    pWhatToRun = Value
End Property

Public Property Get Interval() As String
    Interval = pInterval
End Property
Public Property Let Interval(Value As String)
    pInterval = Value
End Property

Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property

更新:我最终使用了下面的答案。如果将来有人想使用它，这是我的完整代码:

'M_Factory module

Public Function CreateTimer(name As String, interval As String) As C_Timer
    Set newTimer_ = New C_Timer
    newTimer_.name = name
    newTimer_.interval = interval
    Set CreateTimer = newTimer_
End Function

'C_Timer Class

Private pInterval As String
Private pName As String
Private pRunning As Boolean
Private pNextTick

Public Function Process(func)
    If func <> "" Then
        Application.Run func
        pNextTick = Now + TimeValue(pInterval)
        Application.OnTime pNextTick, pName & "_Tick"
    End If
End Function


Public Function StartTimer() As Boolean
On Error GoTo hell

    If TimeValue(pInterval) > TimeValue("00.00.00") And pName <> "" And pRunning <> True Then
        pNextTick = Now + TimeValue(pInterval)
        Application.OnTime pNextTick, pName & "_Tick"
        pRunning = True
    Else
        GoTo hell
    End If
    Exit Function
hell:
        pRunning = False
        M_Settings.SetStatus "Failed to update, close & reopen the document"
End Function

Public Property Get Start() As C_Timer
    StartTimer
    Set Start = Me
End Property

Public Function StopTimer() As Boolean
On Error GoTo hell
    If pRunning = True Then
        Application.OnTime pNextTick, pName & "_Tick", , False
        pRunning = False
    Else
        GoTo hell
    End If
    Exit Function
hell:
        
End Function


Public Property Get interval() As String
    interval = pInterval
End Property
Public Property Let interval(Value As String)
    pInterval = Value
End Property

Public Property Get name() As String
    name = pName
End Property
Public Property Let name(Value As String)
    pName = Value
End Property

'test module

Public Timer1 As C_Timer, Timer2 As C_Timer
Public Sub test()
    Set Timer1 = M_Factory.CreateTimer("Timer1", "00.00.01").Start
    Set Timer2 = M_Factory.CreateTimer("Timer2", "00.00.5").Start
End Sub

Public Function Timer1_Tick()
    Timer1.Process "DoSomething"
End Function

Public Function Timer2_Tick()
    Timer2.Process "DoMoreStuff"
End Function

Public Sub stopit()
    Timer1.StopTimer
    Timer2.StopTimer
End Sub

Function DoSomething()
    Sheets(1).Cells(1, 1).Value = Format(DateTime.Now, "HH:NN:SS")
End Function

Function DoMoreStuff()
    Sheets(1).Cells(1, 2).Value = Format(DateTime.Now, "HH:NN:SS")
End Function

Answer 1

要运行的过程的名称OnTime应该是公开的Sub来自 standard module .您是否尝试过以下操作？

Standard module

Set AutoUpdater = New C_Timer

Public Sub TriggerUpdater()
    AutoUpdater.InsideMyTimerClass
End Sub

Class C_Timer

Application.OnTime pNextTick, "TriggerUpdater"

Public Function InsideMyTimerClass() as Variant
...
End Function