VBA - MouseMove Event for Dynamic Userform Controls (Labels)

[reyes]

Hi all

I'm trying to figure out a way for label controls that are created at runtime to trigger a 'MouseMove' event that will make the control's forecolor white and the remaining controls grey.

These controls are created dynamically based on a number of cells within Excel that are populated after a database check, and therefore the amount of labels required cannot be created at design-time.

Just to make you aware, what I DO have working is making my labels fire off the same event when any of them are clicked based on a WithEvents declaration in my custom class.

In total then, so far, I have:

• A class (called clsEvents) containing a 'WithEvents' declaration
• A '_Click' event with a message box prompt to test whether my dynamic labels fire off this message (they do)
• A module level collection in my userform containing instances of my 'clsEvents' instances to keep them in scope.

I suppose what a lot of this comes down to is finding a way to identify which dynamic label has been clicked. If I knew that, I could either throw the name of the label into a variable and reference it in my 'MouseMove' event which will mean I can set that particular dynamic label's forecolor to white, and all remaining to grey - this, I don't know how to do.

Here's some code:

clsEvents

Option Explicit
Public WithEvents hL_LBL As MSForms.Label
Private Sub hL_LBL_Click()
MsgBox "clsEvents button clicked"
End Sub
Private Sub hL_LBL_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'What goes here...?
End Sub

Userform code

Dim i As Byte
Dim ctrlLBL As MSForms.Label
Dim lblHandler As clsEvents
Dim objUCP
Set objUCP = New clsUCP
Set dynLBLCollection = New Collection
objUCP.LoadUCP
For i = 1 To objUCP.HighlightCollection.count
    Set lblHandler = New clsEvents
    Set ctrlLBL = objUCP.HighlightCollection(i)
    
    Set lblHandler.hL_LBL = ctrlLBL
    dynLBLCollection.Add lblHandler
Next

FYI: the 'clsUCP' merely adds the dynamic controls to a separate collection when the 'LoadUCP' procedure / method is called. All of this works which is why I haven't included any code.

The 'dynLBLCollection' is what is adding each instance of the class generated within the For / Next loop, and is allowing me to see the message box prompt shown in 'clsEvents'.

I hope this all makes sense. Any help / advice would be gratefully received!

Thanks

 

[RoryA]

Here's a simplistic way:

Private Sub hL_LBL_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctl As MSForms.Control
    For Each ctl In hL_LBL.Parent.Controls
        If TypeName(ctl) = "Label" Then
            ctl.ForeColor = RGB(190, 190, 190)
        End If
    Next ctl
    hL_LBL.ForeColor = vbWhite
End Sub

 

[reyes]

Okay, pretty much immediately after, the obvious answer hit me.

For everybody else who comes across a similar situation, my fix was this:

• Add a public property to 'clsEvents' that is set to the WithEvents variable ('hL_LBL' in my case).
• Simply add a For / Each loop to check whether the .Name property of my new public property variable matches the control name in the loop (which works for me as I'm looping through controls within a frame)

That's it!

 

[GTO]

By simple example:

In UserForm1:

Option Explicit
  
'I happened to use an array in place of the Collection
Private MyLabels() As Class1
  
Private Sub UserForm_Initialize()
Const TOP = 12
Dim sngTopOffset As Single
Dim n As Long
Dim OneLabel As MSForms.Label
  
  'RAND 1-6
  Randomize
  ReDim MyLabels(1 To (Int((6 - 1 + 1) * Rnd + 1)))
  
  For n = 1 To UBound(MyLabels)
    Set MyLabels(n) = New Class1
    Set OneLabel = Me.Controls.Add("Forms.Label.1", "MyLabel_" & Format(n, "00"))
    OneLabel.Caption = "Caption " & n
    OneLabel.TOP = TOP + sngTopOffset
    sngTopOffset = sngTopOffset + 24
    OneLabel.Left = 6
    Set MyLabels(n).lbl = OneLabel
    Set MyLabels(n).Parent = Me
  Next
    
End Sub

In Class1:

Option Explicit
  
Public WithEvents lbl As MSForms.Label
  
Private ParentForm As Object
  
Property Set Parent(frm As Object)
  Set ParentForm = frm
End Property
  Property Get Parent() As Object
    Set Parent = ParentForm
  End Property
  
Private Sub lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Parent.Caption = "Mouse over " & lbl.Name
End Sub

Does that help?

Mark

 

[reyes]

Here's a simplistic way:

Private Sub hL_LBL_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim ctl As MSForms.Control
    For Each ctl In hL_LBL.Parent.Controls
        If TypeName(ctl) = "Label" Then
            ctl.ForeColor = RGB(190, 190, 190)
        End If
    Next ctl
    hL_LBL.ForeColor = vbWhite
End Sub

Thanks Rory - much appreciated!

It seems I converged upon a similar solution, albeit with a slight twist.

 

[reyes]

By simple example:

Does that help?

Mark

Indeed it does Mark - thank you for your time.

I'm curious: any particular reason for choosing an array instead of a collection? It may be a moot point but for my own experience / knowledge I'm curious.

 

[GTO]

...any particular reason for choosing an array instead of a collection? It may be a moot point but for my own experience / knowledge I'm curious.

No, mostly its because that's the way I learned from the first example that I grasped (and being simple-minded, why take a chance on confusing myself?).

Mark

 

[reyes]

No, mostly its because that's the way I learned from the first example that I grasped (and being simple-minded, why take a chance on confusing myself?).

Mark

As good a reason as any Mark!