访问VBA（2016）。在运行时使用事件创建控件

Question

我正在尝试在运行时创建带有事件的CheckBoxes。

（原因：我想显示交叉表查询以进行编辑。由于无法完成此操作，因此我希望在以编程方式单击时将值（全部布尔值）反转。）

我的代码创建控件没有问题但由于实例化类时的编译错误而无法运行。 “应用程序定义或对象定义的错误。”

（我的类结构的出发点来自How to add events to Controls created at runtime in Excel with VBA，但我认为这是完全不同的，以保证一个新的线程。）

Me.Sub_FilterVal_Populate.Form.RecordSource = "FilterValsCrosstab" ' Renewing with the same dataset does seem to cause a requery/refresh

Dim ColNum As Integer
Dim ColName As String
Dim ColWid As Integer
Dim ColMax As Integer
Dim CurrentX  As Integer
Dim ctlLabel As Control
Dim ctlChk As Control
Dim CheckArray() As New Class1
CurrentX = 3500
ColWid = 1400

'  ######################   Close any existing example of the sub form without saving
DoCmd.SetWarnings False
    DoCmd.Close acForm, "Sub_Test", acSaveNo
DoCmd.SetWarnings True

'  ######################    Open a fresh copy of the prototype form
DoCmd.OpenForm "Sub_Test", acDesign
ColMax = CurrentDb.QueryDefs("FilterValsCrossTab").Fields.Count - 1
'   ######################   Loop through to create each column checkbox and column header
For ColNum = 2 To ColMax
    ColName = CurrentDb.QueryDefs("FilterValsCrossTab").Fields(ColNum).Name
    Set ctlChk = CreateControl("Sub_Test", acCheckBox, acDetail, , ColName, CurrentX, 1, ColWid, 300) 'Note: Can't edit CrossTabs
        ReDim Preserve CheckArray(1 To ColNum)   ' ######################   Now need to save as New Class with extra events
        Set CheckArray(ColNum).CheckEvents = ctlChk 'FALLS OVER HERE
     Set ctlLabel = CreateControl("Sub_Test", acLabel, acHeader, , ColName, CurrentX, 1, ColWid, 800)  ' Can't name parent in hedaer
        CurrentX = CurrentX + ColWid + 20
    ctlLabel.Caption = ColName
Next
RunCommand acCmdFormView

我的Class1对象看起来像这样

Option Compare Database
Public WithEvents CheckEvents As Access.CheckBox

Public Sub CheckEvents_GotFocus()
   MsgBox "GotFocus!", vbOKOnly, "CheckBox Event"
End Sub

Answer 1

免责声明：我强烈建议您不要采用这种方法，而是将字段动态绑定到预先创建的复选框并隐藏未使用的控件，因为这样可以防止您来回切换到设计视图，从而需要重新编译数据库。在运行代码时重新编译数据库可能会导致状态丢失，从而导致各种问题。

---

答：问题很可能是设计视图中的控件与窗体视图中的控件的行为不同。要设置CheckEvents复选框，您需要将其设置为窗体视图中的复选框，而不是设计视图中的复选框。当您将表单切换到表单视图时，也无法将您在设计视图中创建的控件存储为重复使用，因为它们会在切换后立即清除。

若要解决此问题，您可以创建一组控件名称，然后在窗体切换到窗体视图后设置这些控件的事件处理程序。

Dim collControlNames As New Collection
DoCmd.OpenForm "Sub_Test", acDesign
ColMax = CurrentDb.QueryDefs("FilterValsCrossTab").Fields.Count - 1
'   ######################   Loop through to create each column checkbox and column header
For ColNum = 2 To ColMax
    ColName = CurrentDb.QueryDefs("FilterValsCrossTab").Fields(ColNum).Name
    Set ctlChk = CreateControl("Sub_Test", acCheckBox, acDetail, , ColName, CurrentX, 1, ColWid, 300) 'Note: Can't edit CrossTabs
        ctlChk.OnGotFocus = "[Event Procedure]" 'Required to get the control to send events
        collControlNames.Add ctlChk.Name
     Set ctlLabel = CreateControl("Sub_Test", acLabel, acHeader, , ColName, CurrentX, 1, ColWid, 800)  ' Can't name parent in hedaer
        CurrentX = CurrentX + ColWid + 20
    ctlLabel.Caption = ColName
Next
RunCommand acCmdFormView
Dim l As Long
ReDim CheckArray(1 To collControlNames.Count) 'No need to redim preserve, array is empty
For l = 1 To collControlNames.Count
    Set CheckArray(l) = Forms!Sub_test.Controls(collControlNames(l)) 'Set the controls
Next

根据您的代码判断，您还有几个尚未解决的挑战。例如，CheckArray应该被定义在它持续的某个地方（例如，在任何sub之外的模块中）。