Доступ VBA (2016). Создание элементов управления с событиями во время выполнения

Question

Я пытаюсь создать флажки с событиями во время выполнения.

(Причина: я хочу отобразить перекрестный запрос для редактирования. Так как это невозможно, я хочу сделать значения (все логические) инвертированными, когда они щелкаются программно.)

Мой код создает элементы управления без проблем, но не запускается из-за ошибки компиляции при создании экземпляра класса. " Ошибка приложения или объекта."

(Моя отправная точка для структуры класса пришла от Как добавить события в элементы управления, созданные во время выполнения в Excel с 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 должно быть определено где-то, где оно сохраняется (например, в модуле вне любого подпрограммы).