使用无模式形式处理自定义事件&用户定义的类

时间:2015-11-30 14:12:50

标签: vba excel-vba events event-handling excel

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

问题是虽然调用了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

用户表单 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

事件测试类 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

公共模块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

1 个答案:

答案 0 :(得分:1)

谢谢Dee,这帮助我解决了问题。

将此声明为全局范围:

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

然后事件处理程序按需激发。