class - 如何在VBA中打开通过参数传递给类模块的表单？

Question

我创建了一个带有表单类型私有变量的类，它通过之前在 Access 中创建的Private WithEvents frmFormulary As Form属性集接收表单对象。Public Property Set Formulary(frmForm As Form)当我实例化这个类的一个对象时，我将这个已经在 Access 中创建并且实际上是关闭的表单传递给这个对象，并将这个表单保存在类的私有变量中，目的是加载这个表单而不使用DoCmd.OpenForm "formName". 为了使它成为可能，我在类Public Sub ShowForm()中创建了一个 Sub frmFormulary.Visible = True，但没有成功。当我运行此方法时，应用程序只会停止。如何加载此表单而不必使用DoCmd.OpenForm "formName"表单对象本身通过参数传递？

Answer 1

请按要求找到示例代码。

这是类 clsForm 代码：

----------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

Private WithEvents frmFormulary As Form

Public Event OpenForm(Cancel As Integer)
Public Event LoadForm()
Public Event UnloadForm(Cancel As Integer)
Public Event CloseForm()

Public Property Set Formulary(frmForm As Form)
    Set frmFormulary = frmForm

    frmFormulary.OnOpen = "[Event Procedure]"
    frmFormulary.OnLoad = "[Event Procedure]"
    frmFormulary.OnUnload = "[Event Procedure]"
    frmFormulary.OnClose = "[Event Procedure]"
End Property

Public Sub ShowForm()
    frmFormulary.Visible = True
End Sub

Private Sub frmFormulary_Open(Cancel As Integer)
    RaiseEvent OpenForm(Cancel)
    MsgBox "Event Open from clsFormulary class"
End Sub

Private Sub frmFormulary_Load()
    RaiseEvent LoadForm
End Sub

Private Sub frmFormulary_Unload(Cancel As Integer)
    RaiseEvent UnloadForm(Cancel)
End Sub

Private Sub frmFormulary_Close()
    RaiseEvent CloseForm
End Sub

Private Sub Class_Terminate()
    Set frmFormulary = Nothing
End Sub
----------------------------------------------------------------------------------------

这是表单代码：

----------------------------------------------------------------------------------------
Option Compare Database
Option Explicit

Private Sub btnTeste_Click()
    On Error GoTo TreatError

    Dim objScreen As clsFormulary

    Set objScreen = New clsFormulary

    objScreen.Formulary (Application.CurrentProject.AllForms("frmScreenTest"))
    objScreen.ShowForm

ExitError:
    'Set objScreen = Nothing
    Exit Sub
TreatError:
    Resume ExitError
End Sub
----------------------------------------------------------------------------------------

谢谢。