vba - 使用无模式表单和用户定义的类处理自定义事件

Question

我试图通过让这些例程引发详细说明其进度的自定义事件，在无模式表单上显示各种例程的进度。表单应处理这些事件以显示适当的信息。

问题是尽管调用了 RaiseEvent，但事件处理程序并没有做任何事情。

以下代码的预期结果是，只要 triggerTest 引发事件，就会调用两个 debug.prints。

我取得的唯一成功是通过以下代码中的 CommandButton1_Click 在用户窗体中引发错误。然后表单的事件处理程序启动(相当多余，但也许这意味着我走在正确的道路上)。

谢谢

事件类 clsChangeProgressTrigger

Option Explicit

Public Enum geProgressStatus
    geProgressStatusComplete = -1
    geProgressStatusRestart = -2
End Enum

Public Event ChangeProgress(dProgress As Double, sProcedure As String)
'

Public Sub Update(dProgress As Double, sProcedure As String)
    RaiseEvent ChangeProgress(dProgress, sProcedure)
End Sub

Public Sub Complete(sProcedure As String)
    RaiseEvent ChangeProgress(geProgressStatusComplete, sProcedure)
End Sub

Public Sub Restart(sProcedure As String)
    RaiseEvent ChangeProgress(geProgressStatusRestart, sProcedure)
End Sub

用户表单 frm 输出

Option Explicit
Private WithEvents mProgressTrigger As clsChangeProgressTrigger
'

Private Sub CommandButton1_Click()
    Call mProgressTrigger.Update(12.34, "SomeValue")
End Sub

Private Sub CommandButton2_Click()
    Call modZTest.triggerTest
End Sub

Private Sub UserForm_Initialize()
    Set mProgressTrigger = New clsChangeProgressTrigger
End Sub

Private Sub mProgressTrigger_ChangeProgress(dProgress As Double, sProcedure As String)
    Debug.Print "Form Event Handled"
End Sub

事件测试类 clsEventTest

Option Explicit

Private WithEvents mProgressTrigger As clsChangeProgressTrigger
'

Private Sub mProgressTrigger_ChangeProgress(dProgress As Double, sProcedure As String)
    Debug.Print "Class Event Handled"
End Sub

Private Sub Class_Initialize()
    Set mProgressTrigger = New clsChangeProgressTrigger
End Sub

公共(public)模块 modZTest 中的测试包装器

Public Sub triggerTest()

    Application.EnableEvents = True

    ' Instantiate Trigger class for this routine
    ' Dim cChangeProgressTrigger As clsChangeProgressTrigger
    Set gChangeProgressTrigger = New clsChangeProgressTrigger

    ' Instantiate Event Test class, which should handle raised event
    Dim cEventTest As clsEventTest
    Set cEventTest = New clsEventTest

    ' Instantiate user form, which should handle raised event
    Set gfrmOutput = New frmOutput  ' Modeless form, gfrmOutput has global scope
    gfrmOutput.Show

    Stop

    ' Raise an event
    Call gChangeProgressTrigger.Complete("SomeValue")

    ' Tidy Up
    Set gfrmOutput = Nothing
    Set gChangeProgressTrigger = Nothing
    Set cEventTest = Nothing

End Sub

Answer 1

谢谢迪，这帮助我找到了解决方案。

将此声明为全局范围:

Public gChangeProgressTrigger As clsChangeProgressTrigger

我必须按如下方式更改类/表单级别的初始化:

Private Sub UserForm_Initialize()
    ' Set mProgressTrigger = New clsChangeProgressTrigger ' Old
    Set mProgressTrigger = gChangeProgressTrigger ' New
End Sub

和

Private Sub Class_Initialize()
    ' Set mProgressTrigger = New clsChangeProgressTrigger ' Old
    Set mProgressTrigger = gChangeProgressTrigger ' New
End Sub

然后事件处理程序根据需要触发。