CODEWITHSUNDEEP
vbaexcel
Serveira
Serveira

Reputation: 51

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

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?

Upvotes: 2

Views: 1790

Answers (1)

KacireeSoftware
KacireeSoftware

Reputation: 808

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

Upvotes: 2

Related Questions