访问 VBA (2016).在运行时创建具有事件的控件



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

(原因:我想显示交叉表查询以进行编辑。 由于无法做到这一点,我想在以编程方式单击值(所有布尔值(时反转。

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

(我对类结构的起点来自如何使用 VBA 将事件添加到运行时在 Excel 中创建的控件,但我认为这足以保证一个新线程。

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

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


答:最有可能的问题是设计视图中的控件与窗体视图中的控件的行为不同。若要设置该"检查事件"复选框,需要将其设置为等于窗体视图中的复选框,而不是设计视图中的复选框。您也不能在设计视图中存储正在创建的控件,以便在将窗体切换到窗体视图时重复使用,因为它们在切换后会立即清除。

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

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应该在它持久存在的某个地方定义(例如,在任何子之外的模块中(。

最新更新