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应该在它持续存在的地方定义（例如，在任何子目录之外的模块中）。

存取VBA（2016）。在运行时创建带有事件的控件

1 个答案: