Assign class module to Form controls (1 Viewer)

'>>>>
Option Compare Database
Option Explicit

Public WithEvents lblTask As Label

Private Sub lblTask_Click()
    lblTask.Caption = "qq"
    MsgBox lblTask.Name
End Sub

Private clsLblClick(1 To 3) As New clsLbls

Private Sub Form_Load()
    Dim i As Integer
    Dim lblThis As Label
    'add class to labels for click event handling
    For i = 1 To 3
        Set lblThis = Me.Controls("Lbl" & i)
        Set clsLblClick(i).lblTask = lblThis
    Next i
End Sub

Option Compare Database
Option Explicit

Private WithEvents mLabel As Access.Label
Private mName As String
Public Property Get Name() As String
  Name = mLabel.Name
End Property
Public Property Get TaskLabel() As Access.Label
  Set TaskLabel = mLabel
End Property
Public Property Set TaskLabel(TheLabel As Access.Label)
 ' On Error GoTo ErrHandler
  Set mLabel = TheLabel
  'You can add More Events and more controls here
   mLabel.OnClick = "[Event Procedure]"
  ' ....
  Exit Property
ErrHandler:
   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 mLabel_Click()
  MsgBox mLabel.Caption & " " & Me.Name
End Sub

Option Compare Database
Option Explicit

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

'************************ Class Code Start ****************************************************

Private mTaskLabels As New Collection
Public Function Add(TheLabel As Access.Control, ctlName As String) As TaskLabel
   Dim newTaskLabel As TaskLabel
   Set newTaskLabel = New TaskLabel
   Set newTaskLabel.TaskLabel = TheLabel
   mTaskLabels.Add newTaskLabel, ctlName
   Set Add = newTaskLabel
End Function
Public Property Get count() As Integer
   count = mTaskLabels.count
End Property
Public Property Get Item(ByVal index As Variant) As TaskLabel
   Set Item = mTaskLabels(index)
End Property
Public Sub Remove(index As Variant)
   mTaskLabels.Remove (index)
End Sub
Public Sub Remove_ByName(ByVal TheName As String)
   Dim i As Integer
   For i = 1 To mTaskLabels.count
     If mTaskLabels(i).Name = TheName Then
        Remove (i)
        Exit Sub
     End If
   Next
End Sub

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

Public Property Get Item_ByName(ByVal TheName As String) As TaskLabel
   Dim Tasklbl As TaskLabel
   For Each Tasklbl In mTaskLabels
     If Tasklbl.Name = TheName Then
       Set Item_ByName = Tasklbl
     End If
   Next
End Property

Private Sub cmdDemo_Click()
  'Demo by index
  MsgBox MyTasks.Item(1).Name
  'Demo by name. Note did not add a caption property to TaskLabels
  MsgBox MyTasks.Item_ByName("Label7").TaskLabel.Caption
  'Demo Remove
  MsgBox "Count " & MyTasks.count
  MsgBox "Last " & MyTasks.Item(1).Name
  MyTasks.Remove (MyTasks.count)
  MsgBox "Count " & MyTasks.count
  'Demo Remove by Name
  MyTasks.Remove_ByName ("label19")
  MsgBox "Count " & MyTasks.count
End Sub

Private Sub Form_Load()
  Dim ctl As Access.Control
  For Each ctl In Me.Controls
     If ctl.Tag = "T" Then
        MyTasks.Add ctl, ctl.Name
      End If
  Next ctl
End Sub

Private Sub mLabel_DblClick(Cancel As Integer)
MsgBox mLabel.Caption & " " & Me.Name & " double clicked"
End Sub

mLabel.OnClick = "[Event Procedure]"
mLabel_DblClick = "[Event Procedure]"

mLabel.OnClick = "[Event Procedure]"
mLabel_DblClick(Cancel As Integer) = "[Event Procedure]"

Private Sub mLabel_Click()
  MsgBox mLabel.Caption & " " & Me.Name
End Sub

mLabel.OnClick = "[Event Procedure]"

[Event Procedure]
[Embedded Macro]
=SomeFunction()

Private Sub mLabel_Click()
  MsgBox mLabel.Caption & " " & Me.Name
End Sub

Private Sub mLabel_DblClick(Cancel As Integer)
  MsgBox mLabel.Caption & " Has been double clicked"  'Handles the event
End Sub

Public Function HelloWorld()
  msgBox "Hello World"
End Function

=HelloWorld()