Simulating a Control Array

Option Compare Database
Option Explicit
Dim ccControls As New CommonControls
Private Sub Form_Load()
  On Error Resume Next
  Dim ctl As Access.Control
  For Each ctl In Me.Controls
    If ctl.ctlType = acTextBox Or ctl.ctlType = acLabel Or ctl.ctlType = acListBox Or ctl.ctlType = acComboBox Then
      If ctl.Tag = "?" Then
        ccControls.Add ctl, ctl.Name
      End If
    End If
  Next ctl
End Sub

'Class Module Name: CommonControl
'Developed by: MajP
'
'Purpose: This Class Module along with the CommonControls collection allows you to build a
'pseudo control array that will react to one or more events.  I only demonstrated using
'Text boxes, List boxes, Combo boxes, and Labels.  I only demonstrated the OnClick Event and
'the BeforeUpdate event. You can easily add more controls and events by following the code.

'How to use:
'1. Place this code in a CLASS (NOT A STANDARD MODULE) module named "CommonControl"
'2. You can use this code without the custom collection, but it has little utility
'3. Read the instructions for the CommonControls custom collection and place the
'CommonControls class in a CLASS module called "CommonControls"
'4. Place your common event procedures in a standard module or modify the event procedures within
'below code
'5. The example below is one way to use the class. For the controls you want to react to events
'place a ? mark in the tag propery. Do not enclose in parentheses.  Then on the form
'
'************************ Form Code Start *****************************************************
'Option Compare Database
'Option Explicit
'Dim ccControls As New CommonControls
'Private Sub Form_Load()
'  On Error Resume Next
'  Dim ctl As Access.Control
'  For Each ctl In Me.Controls
'    If ctl.ctlType = acTextBox Or ctl.ctlType = acLabel Or ctl.ctlType = acListBox Or ctl.ctlType = acComboBox Then
'      If ctl.Tag = "?" Then
'        ccControls.Add ctl, ctl.Name
'      End If
'    End If
'  Next ctl
'End Sub
'************************ Form Code End *******************************************************
'
'************************ Class Code Start ****************************************************

Option Compare Database
Option Explicit

Private WithEvents mLabel As Access.Label
Private WithEvents mTextBox As Access.TextBox
Private WithEvents mlistBox As Access.ListBox
Private WithEvents mComboBox As Access.ComboBox
Private WithEvents mcheckBox As Access.CheckBox
Private mControl As Access.Control

Private mName As String
Public Property Get CommonControl() As Access.Control
  Set CommonControl = mControl
End Property
Public Property Set CommonControl(ByVal ctlControl As Access.Control)
  On Error GoTo ErrHandler
  Set mControl = ctlControl
  'More Events and more controls could be added here
  Select Case ctlControl.ControlType
     Case acLabel
     Set mLabel = ctlControl
     mLabel.OnClick = "[Event Procedure]"
    Case acTextBox
     Set mTextBox = ctlControl
     mTextBox.OnClick = "[Event Procedure]"
     mTextBox.BeforeUpdate = "[Event Procedure]"
     mTextBox.OnChange = "[Event Procedure]"
    Case acListBox
     Set mlistBox = ctlControl
     mlistBox.OnClick = "[Event Procedure]"
     mlistBox.BeforeUpdate = "[Event Procedure]"
    Case acComboBox
     Set mComboBox = ctlControl
     mComboBox.OnClick = "[Event Procedure]"
     mComboBox.BeforeUpdate = "[Event Procedure]"
  End Select
  Exit Property
ErrHandler:
   'Not sure why 459 (does not support events"
   'or 91 (object not set) errors are thrown. I think it has to do
   'with using a generic Access.Control object
   If Not (Err.Number = 459 Or Err.Number = 91) Then
      MsgBox ("Error: " & Err.Number _
            & " " & Err.Description _
            & " " & Err.Source)
   End If
   Resume Next
End Property

Private Sub mTextBox_Click()
  Call commonClickProcedure(mTextBox)
End Sub
Private Sub mTextBox_BeforeUpdate(Cancel As Integer)
  Call commonBU_Procedure(mTextBox)
End Sub

Private Sub mComboBox_Click()
  Call commonClickProcedure(mComboBox)
End Sub

Private Sub mComboBox_BeforeUpdate(Cancel As Integer)
  Call commonBU_Procedure(mComboBox)
End Sub

Private Sub mLabel_Click()
  Call commonClickProcedure(mLabel)
End Sub
Private Sub mListBox_Click()
  Call commonClickProcedure(mlistBox)
End Sub
Private Sub mlistBox_BeforeUpdate(Cancel As Integer)
  Call commonBU_Procedure(mlistBox)
End Sub

Public Property Get Name() As String
  Name = mName
End Property

Public Property Let Name(ByVal strName As String)
  mName = strName
End Property
'*********************************** Class Code End ********************************************

'Class Module Name: CommonControls
'Developed by: MajP
'
'Purpose: This Class Module is the collection class for the object class "CommonControls"
'The collection allows you to build a pseudo control array that will react to one or more events.

'How to use:
'1. Place this code in a CLASS (NOT A STANDARD MODULE) module named "CommonControls"
'2. Read the instructions for the CommonControl class
'
'************************ Class Code Start ****************************************************

Option Compare Database
Option Explicit
Private mCommonControls As New Collection
Public Function Add(ctlControl As Access.Control, ctlName As String) As CommonControl
   Dim newCommonControl As CommonControl
   Set newCommonControl = New CommonControl
   Set newCommonControl.CommonControl = ctlControl
   newCommonControl.Name = ctlName
   mCommonControls.Add Item:=newCommonControl, Key:=ctlName
   Set Add = newCommonControl
End Function
Public Property Get count() As Integer
   count = mCommonControls.count
End Property
Public Property Get Item(ByVal index As Variant) As CommonControl
   Set Item = mCommonControls(index)
End Property
Public Sub Remove(index As Variant)
   mCommonControls.Remove (index)
End Sub

Private Sub Class_Initialize()
  'MsgBox "class Intialized"
End Sub

Private Sub Class_Terminate()
 Set mCommonControls = Nothing
End Sub
Public Sub Clear()
    Set mCommonControls = New Collection
End Sub

Public Function commonClickProcedure(ctl As Access.Control)
  'put your click event here
  MsgBox "Click " & ctl.Name
End Function
Public Function commonBU_Procedure(ctl As Access.Control)
  'put your before update event here
  MsgBox "Before Update " & ctl.Name & " " & ctl.Value
End Function