VBA - Apply same MouseMove code to all Labels (Event Handling Collections) - vba

Question

I have a few Labels on my worksheet, and each one has the following code to display on the Status Bar the Range they're currently at (as the mouse moves over them):
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
rng = ActiveSheet.Shapes("Label1").TopLeftCell.Address
Application.StatusBar = rng
End Sub
Is there any way I can apply this same code to ALL the labels instead of rewriting it over and over again?

Answer 1

I added a new class called LabelHandler:
Option Explicit
Public WithEvents lbl As msforms.Label
Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim rng As String
rng = ActiveSheet.Shapes(lbl.Name).TopLeftCell.Address
Application.StatusBar = rng
End Sub
In a New Module I added the following:
Public myLabels As Collection 'Of LabelHandler
Sub init()
Dim ws As Worksheet
Dim myLabel As LabelHandler
Set myLabels = New Collection
For Each l In ActiveSheet.OLEObjects
Set myLabel = New LabelHandler
Set myLabel.lbl = l.Object
myLabels.Add myLabel
Next
End Sub
Now when I run my cursor over the label, I get $F$11 in the status window
EDIT
You will want to edit your For Each loop to only add the label objects you want to the collection. Perhaps by their Name property
For Each l In ActiveSheet.OLEObjects
If Left(l.Name,5)="Label" Then
Set myLabel = New LabelHandler
Set myLabel.lbl = l.Object
myLabels.Add myLabel
End If
Next
Or for all Labels:
For Each l In ActiveSheet.OLEObjects
If l.progID = "Forms.Label.1" Then
Set myLabel = New LabelHandler
Set myLabel.lbl = l.Object
myLabels.Add myLabel
End If
Next