none
Track control on userform RRS feed

  • Question

  • Hi All,

    I build a userform with about 50 labels and at initializing it puts style information on each label. Not perfect but Hans Vogelaar explained why. Not happy but can live with the work around.

    Now, I want to put the "focus" on the control when the mousepointer is going over it. By focus I mean change the control specialeffect to raised and back to flat is the mousepointer is no longer over the label.

    OK, I can write a mousemove event for each control but as said, there are about 50 labels and so I am looking for a more generic code.

    I've already this, sorry for the mesh in the code, I'm just trying and trying.

    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
       Dim objControl As MSForms.Label
       
       'Debug.Print X, Y
       For Each objControl In Me.Controls
          With objControl
             If (.Left <= X And (.Left + .Width) >= X) And (.Top <= Y And (.Top + .Height) >= Y) Then
                '.SpecialEffect = fmSpecialEffectRaised
                Debug.Print X, Y, "yes"
                
             Else
                '.SpecialEffect = fmSpecialEffectFlat
                'Stop
                Debug.Print X, Y, "no"
             End If
          End With
       Next objControl
    End Sub

    This works partionally but not as expected. My tests, I can be wrong, showed that when the mouse is over a control, X & Y do not change anymore till I am back over the userform.

    An idea could be ... if I'm near the control ... take it as the the control. But better ideas are welcome.

    The whole idea behind, if more people are working on the same workbook I'll give the option to mark their changes and to the one who has to review to see easily which cells are changed.

    Kind regards,

    JP

    Sunday, July 9, 2017 1:19 PM

Answers

  • Do the following:

    1) Create a new class module and name it clsLabel.

    Copy the following code into the class module:

    Public WithEvents myLabel As MSForms.Label
    
    Private Sub myLabel_MouseMove(ByVal Button As Integer, _
            ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        myLabel.SpecialEffect = fmSpecialEffectRaised
    End Sub

    2) Copy the following code into the userform module:

    Private arrLabels() As New clsLabel
    
    Private Sub UserForm_Initialize()
        Dim ctl As Control
        Dim n As Long
        For Each ctl In Me.Controls
            If TypeName(ctl) = "Label" Then
                n = n + 1
                ReDim Preserve arrLabels(1 To n)
                Set arrLabels(n).myLabel = ctl
            End If
        Next ctl
    End Sub
    
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Dim ctl As Control
        For Each ctl In Me.Controls
            If TypeName(ctl) = "Label" Then
                ctl.SpecialEffect = fmSpecialEffectFlat
            End If
        Next ctl
    End Sub

    Note #1: if you had already created a UserForm_Initialize event procedure, you'll have to merge it with the one above. As you know, there can be only one UserForm_Initialize event procedure for a form.

    Note #2: if you had already created MouseMove event procedures for the labels from the userform module, delete them.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, July 9, 2017 2:58 PM
  • If the labels are close to each other it can happen that the mouse cursor did not "touch" the Userform, the result is that more as one label can be raised at a time.

    To prevent that use this property instead:

    Public Property Let RaiseLabel(ByVal ThisLabel As MSForms.Label, ByVal Value As fmSpecialEffect)
      'If a label is raised...
      If Not LastLabel Is Nothing Then LastLabel.SpecialEffect = fmSpecialEffectFlat
      'Remember the last label
      Set LastLabel = ThisLabel
      'Set the property value
      ThisLabel.SpecialEffect = Value
    End Property

    Andreas.

    • Marked as answer by JP Ronse Saturday, July 15, 2017 9:50 AM
    Monday, July 10, 2017 7:09 AM

All replies

  • Do the following:

    1) Create a new class module and name it clsLabel.

    Copy the following code into the class module:

    Public WithEvents myLabel As MSForms.Label
    
    Private Sub myLabel_MouseMove(ByVal Button As Integer, _
            ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        myLabel.SpecialEffect = fmSpecialEffectRaised
    End Sub

    2) Copy the following code into the userform module:

    Private arrLabels() As New clsLabel
    
    Private Sub UserForm_Initialize()
        Dim ctl As Control
        Dim n As Long
        For Each ctl In Me.Controls
            If TypeName(ctl) = "Label" Then
                n = n + 1
                ReDim Preserve arrLabels(1 To n)
                Set arrLabels(n).myLabel = ctl
            End If
        Next ctl
    End Sub
    
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Dim ctl As Control
        For Each ctl In Me.Controls
            If TypeName(ctl) = "Label" Then
                ctl.SpecialEffect = fmSpecialEffectFlat
            End If
        Next ctl
    End Sub

    Note #1: if you had already created a UserForm_Initialize event procedure, you'll have to merge it with the one above. As you know, there can be only one UserForm_Initialize event procedure for a form.

    Note #2: if you had already created MouseMove event procedures for the labels from the userform module, delete them.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, July 9, 2017 2:58 PM
  • Now, I want to put the "focus" on the control when the mousepointer is going over it. By focus I mean change the control specialeffect to raised and back to flat is the mousepointer is no longer over the label.

    OK, I can write a mousemove event for each control but as said, there are about 50 labels and so I am looking for a more generic code.

    No problem, we can use a class and grab the MouseMove events of all the labels.

    Add a class module, name it "MyLabelRaiser" and add this code:

    Option Explicit
    
    Public Parent As Object 'Our userform which contains the property RaiseLabel
    Public WithEvents MyLabel As MSForms.Label
    
    Private Sub MyLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      Parent.RaiseLabel(MyLabel) = fmSpecialEffectRaised
    End Sub

    In the userform use this code:

    Option Explicit
    
    Dim LastLabel As MSForms.Label
    Dim MyLabels As New Collection
    
    Public Property Let RaiseLabel(ByVal ThisLabel As MSForms.Label, ByVal Value As fmSpecialEffect)
      'Remeber the last label
      Set LastLabel = ThisLabel
      'Set the property value
      ThisLabel.SpecialEffect = Value
    End Property
    
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      'If a label is raised...
      If Not LastLabel Is Nothing Then
        '...put it down
        LastLabel.SpecialEffect = fmSpecialEffectFlat
        'Done
        Set LastLabel = Nothing
      End If
    End Sub
    
    Private Sub UserForm_Initialize()
      Dim ML As MyLabelRaiser
      Dim C As MSForms.Control
      
      'Visit each control
      For Each C In Me.Controls
        'A label?
        If TypeOf C Is MSForms.Label Then
          'Create a new class
          Set ML = New MyLabelRaiser
          With ML
            'Enable our events for this control
            Set .MyLabel = C
            'Add a pointer to this userform
            Set .Parent = Me
          End With
          'Keep it alive
          MyLabels.Add ML
        End If
      Next
    End Sub
    

    BTW, if you move the mouse cursor over a label and then if you move it very fast out of the window, you'll see that the label stays raised. There is no way to prevent that, because we have no event to catch a "mouse leave window". But IMHO no issue, if you move the mouse back to the Userform, the label toggles as before.

    Andreas.

    Sunday, July 9, 2017 3:09 PM
  • If the labels are close to each other it can happen that the mouse cursor did not "touch" the Userform, the result is that more as one label can be raised at a time.

    To prevent that use this property instead:

    Public Property Let RaiseLabel(ByVal ThisLabel As MSForms.Label, ByVal Value As fmSpecialEffect)
      'If a label is raised...
      If Not LastLabel Is Nothing Then LastLabel.SpecialEffect = fmSpecialEffectFlat
      'Remember the last label
      Set LastLabel = ThisLabel
      'Set the property value
      ThisLabel.SpecialEffect = Value
    End Property

    Andreas.

    • Marked as answer by JP Ronse Saturday, July 15, 2017 9:50 AM
    Monday, July 10, 2017 7:09 AM
  • Hi Hans,

    Thanks for the code, I'll give it a try next weekend and keep you posted.

    Regards,

    JP


    • Edited by JP Ronse Monday, July 10, 2017 4:21 PM
    Monday, July 10, 2017 4:18 PM
  • Hi Andreas,

    Thanks for the code, I'll give it a try next weekend. I don't think that the labels are too close to each other but I'll keep in mind and will test.

    Regards,

    JP

    • Edited by JP Ronse Monday, July 10, 2017 4:21 PM
    Monday, July 10, 2017 4:21 PM
  • Hi Hans, Andreas,

    Both proposals work very well and I could have chosen either one or the other. It ended up with a mixt of both codes.

    Andreas' idea to define the parent object in the class was very useful for the further development of this small project but I have to say that it was easy to implement it in Hans' code.

    Just raising a label has no sense if you do nothing with it. Purpose was/is that the user can click (mouse_down) the label to store the selected label and when recalling the userform to raise the selected label.

    Thanks again both.

    Kind regards,

    JP

    Saturday, July 15, 2017 9:49 AM