CODEWITHSUNDEEP
vbams-accesseventsruntime
SolwiseMD
SolwiseMD

Reputation: 79

Access VBA (2016). Creating Controls with events at runtime

I'm trying to create CheckBoxes with events at runtime.

(Reason: I want to display a crosstab query for editing. Since this can't be done I want to make the values (all Boolean) invert when they are clicked programmatically.)

My code creates the controls no problem but won't run because of a compile error when the class is instantiated. "Application-defined or object-defined error."

(My starting point for the class structure came from How to add events to Controls created at runtime in Excel with VBA but I think this is sufficiently different to warrant a new thread.)

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

My Class1 object looks like this

Option Compare Database
Public WithEvents CheckEvents As Access.CheckBox

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

Upvotes: 2

Views: 1643

Answers (1)

Erik A
Erik A

Reputation: 32672

DISCLAIMER: I highly recommend you don't take this approach, but instead dynamically bind fields to precreated checkboxes and hide unused controls, since that will keep you from switching back and forth to design view, requiring your database to be recompiled. Recompiling your database while running code can cause a state loss leading to all kinds of problems.

Answer: The problem of most likely is that controls in design view don't behave the same as controls in form view. To set that CheckEvents check box, you need to set it equal to a check box in form view, not one in design view. You also can't store the controls you're creating in design view to re-use when you've switched the form to form view, because they're cleared as soon as it switches.

To work around this, you can create a collection of control names, and then set the event handlers for these controls after the form switched to form view.

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

There are several challenges you haven't tackled yet, judging by your code. For one, CheckArray should be defined somewhere it persists (e.g. in a module outside of any sub).

Upvotes: 1

Related Questions