Control array event handler
The guys at Webucator training services but together a video based on this approach.
Within VBA it is not possible to have an array of controls. Each control must have a unique name and it's own set of events. If you want to handle an event, such as Click, for multiple controls with similar code you have two approaches available. The first is to add code to the event of each control. The other is to use a class taking advantage of the WithEvents and create objects based on the class.
The first approach means that lots of code, often repetitive in nature, is required. Also the controls must be present at design time in order to add the code to the controls event.
The second approach reduces the repetitive code and can be applied to controls created at run time.
In this article I want to address the issue of loose and tight coupling within the class approach. Most explanations of the technique use a tightly coupled approach. This is were the class includes an explicit reference(s) to the userform containing the control. This means the class can not easily be reused in other projects without altering code in either the class or userform or both.
As an example I will create a colour picker userform using each approach. Each user form will appear the same and have the same functionailty, which is to allow the user to select a colour by clicking from a swatch of colours. When a colour is clicked the larger colour tile is updated to reflect the selected colour.
All examples have a routine, m_CreatePalette, to layout the labels used for the colours.
If the AddControls argument is TRUE then the controls will also be added to the userform at run time.
Private Const mCOLORPOT_PREFIX = "ColorPot_" Private Sub m_CreatePalette(AddControls As Boolean) Dim RowIndex As Long Dim ColIndex As Long Dim TempCtl As MSForms.Label Dim Left As Single Dim Top As Single Dim Name As String Dim Palette As Range Const COLORPOT_GAP = 2 Const COLORPOT_SIZE = 24 Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange Top = COLORPOT_GAP For RowIndex = 1 To Palette.Rows.Count Left = COLORPOT_GAP For ColIndex = 1 To Palette.Columns.Count Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00") If AddControls Then Set TempCtl = Me.Controls.Add("Forms.Label.1", Name, True) Else Set TempCtl = Me.Controls(Name) End If With TempCtl .Left = Left .Top = Top .Width = COLORPOT_SIZE .Height = COLORPOT_SIZE .Caption = "" .SpecialEffect = fmSpecialEffectSunken .BackColor = Palette.Cells(RowIndex, ColIndex).Interior.Color End With Left = Left + COLORPOT_SIZE + COLORPOT_GAP Next Top = Top + COLORPOT_GAP + COLORPOT_SIZE Next End Sub
Non class events
Each control was created at design time and has code for the Click event. Below is only the code for 7 of the controls but hopefully you get the idea of how much reptetive code is required.
Private Sub ColorPot_01_01_Click() CurrentColor.BackColor = ColorPot_01_01.BackColor End Sub Private Sub ColorPot_01_02_Click() CurrentColor.BackColor = ColorPot_01_02.BackColor End Sub Private Sub ColorPot_01_03_Click() CurrentColor.BackColor = ColorPot_01_03.BackColor End Sub Private Sub ColorPot_01_04_Click() CurrentColor.BackColor = ColorPot_01_04.BackColor End Sub Private Sub ColorPot_01_05_Click() CurrentColor.BackColor = ColorPot_01_05.BackColor End Sub Private Sub ColorPot_01_06_Click() CurrentColor.BackColor = ColorPot_01_06.BackColor End Sub Private Sub ColorPot_01_07_Click() CurrentColor.BackColor = ColorPot_01_07.BackColor End Sub ' ' ... more Click event code for remaining 53 labels removed for brevity '
Class events
The class event approach requires code in the userform to store the objects and link them to the controls.
Private m_Pots As Collection Private Sub m_AssignEvents() Dim Palette As Range Dim RowIndex As Long Dim ColIndex As Long Dim Name As String Dim ColorPot As CEventTight Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange For RowIndex = 1 To Palette.Rows.Count For ColIndex = 1 To Palette.Columns.Count Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00") Set ColorPot = New CEventTight Set ColorPot.Pot = Me.Controls(Name) m_Pots.Add ColorPot, CStr(m_Pots.Count + 1) Next Next End Sub
The class is named CEventTight
Public WithEvents Pot As MSForms.Label Private Sub Pot_Click() Pot.Parent.CurrentColor.BackColor = Pot.BackColor End Sub
Whilst the quantity of code in the class is small it is tightly coupled as it references the CurrentColor control in the user form. This means that to reuse the class the form must have a control named CurrentColor.
Class event handler
There are actually 2 classes required. One acts as storage of references to indiviual objects. It also raises the event which can be exposed in the userform.CEventHandler
Public Event Click(Index As Long) Private m_Pots As Collection Public Function Add(Ctl As MSForms.Label) As CEventLoose Dim TempCtl As CEventLoose Set TempCtl = New CEventLoose TempCtl.Index = m_Pots.Count + 1 Set TempCtl.Parent = Me Set TempCtl.Pot = Ctl m_Pots.Add TempCtl, Ctl.Name Set Add = TempCtl End Function Public Property Get Count() As Long Count = m_Pots.Count End Property Public Function Item(Index As Variant) As CEventLoose On Error Resume Next Set Item = m_Pots(Index) Exit Function End Function Public Function Items() As Collection Set Items = m_Pots End Function Public Sub Remove(Index As Variant) On Error Resume Next m_Pots.Remove Index Exit Sub End Sub Private Sub Class_Initialize() Set m_Pots = New Collection End Sub Private Sub Class_Terminate() Do While m_Pots.Count > 0 m_Pots.Remove m_Pots.Count Loop Set m_Pots = Nothing End Sub Public Sub EventClick(Index As Long) RaiseEvent Click(Index) End SubCEventLoose
Public WithEvents Pot As MSForms.Label Public Parent As CEventHandler Public Index As Long Private Sub Pot_Click() Me.Parent.EventClick Index End SubUserform code to declare and consume the event handler
Private WithEvents m_Pots As CEventHandler Private Sub m_Pots_Click(Index As Long) CurrentColor.BackColor = m_Pots.Item(Index).Pot.BackColor End Sub Private Sub m_AssignEventHandler() Dim Palette As Range Dim RowIndex As Long Dim ColIndex As Long Dim Name As String Dim ColorPot As MSForms.Label Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange For RowIndex = 1 To Palette.Rows.Count For ColIndex = 1 To Palette.Columns.Count Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00") Set ColorPot = Me.Controls(Name) m_Pots.Add ColorPot Next Next End SubThe CEventLoose class captures the click event in the same way as the CEventTight does. But rather than changing the property of a control directly it calls a routine in the CEventHandler class, passing information about which object it is, allowing the handler to raise an event. This event is exposed by the object when declared WithEvents in the userform. When the event fires code within the userform can process any actions required. This means the 2 classes can be used in any project without the need for code changes. All project specific code is done within the userform.
In the example I have only used the Click event but the principle can be extended to all events that are exposed when using WithEvents. Unfortunately this is not the complete complement of events as a few, such as Enter and Exit, are only exposed when used in a suitable container object.
The download file also includes another example file where events are reported to a listbox. Along with event code to provide special textboxes for upper case, lower case and numeric entry only.