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

Question

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

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

以下代码的预期结果是两个 debug.prints 将在 triggerTest 引发事件时调用。

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

谢谢

事件classclsChangeProgressTrigger

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

用户表单frmOutput

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

事件测试classclsEventTest

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

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

将此声明为全局范围：

Public gChangeProgressTrigger As clsChangeProgressTrigger

我必须按如下方式更改 class/表单级初始化：

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

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

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

Handling custom events using modeless form & user defined classes

excel

events

vba

event-handling

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

Handling custom events using modeless form & user defined classes

excel

events

vba

event-handling

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