我试图通过让这些例程引发详细说明其进度的自定义事件,以无模式形式显示各种例程的进度。表单应处理这些事件以显示适当的信息。
问题是虽然调用了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
答案 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
然后事件处理程序按需激发。