Search code examples
vbavba7vba6

How to modify the appearance of UserForm Labels using Class Module?


I have this UserForm (Image 1) and I'm trying to apply some customization through Class Module. So, my first goal was to modify the label format when it was clicked (Image 2). So far so good, I've accomplished this through the Class Module "cLabels". Now, my second goal is (this is the one I'm stuck) to apply some other color to the aforementioned Label. The point is, I don't know how to accomplish this.

I tried to create other class module called "cUserForm", but I don't how to pass the label modified to the cUserForm Class Module and use its MouseMove Event. I know I could apply the modification through the standard UserForm Module using the MouseMove Event, but the thing is, I don't want any code like that in my UserForm Module, I want the class module doing the "dirty" work. Do guys have any ideas how can I circumvent the problem?

Additional information (but not important to solve the problem): My final goal is to make "Buttons" like this https://drive.google.com/file/d/1ev_LNgxPqjMv0dtzlF7GSo7SOq0wDbR2/view?usp=sharing with some effects such as MouseHover, TabPress and so on. VBA buttons are very ugly. Just for the record, I've already done all this in a standard UserForm module (If anyone wants the workbook to see what I'm talking about, I have it), but the final result was just a mess, so many code (and It was just the code to modify the appearance of the UserForm, imagine when I put some code to do certain action, omg).

Image 1

Image 2

Here is what I have so far:

UserForm Module

Option Explicit

Private ObjLabel As cLabels
Private ObjUserForm As cUserForm

Private Sub UserForm_Initialize()

 Set ObjLabel = New cLabels
 ObjLabel.CallClasse Me
 
 Set ObjUserForm = New cUserForm
 Set ObjUserForm.UserFormValue = Me
 
End Sub

cLabels

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsLabel As MSForms.Label

Private ClasseObject As cLabels
Private LabelCollection As New Collection

'## Properties
Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = clsLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set clsLabel = Value
End Property

'## Procedures/Methods
Private Sub clsLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 LabelHovered
End Sub

Public Sub CallClasse(MainObject As MSForms.UserForm)

 Dim ctrl As MSForms.Control

 For Each ctrl In MainObject.Controls

    If TypeOf ctrl Is MSForms.Label Then
        Set ClasseObject = New cLabels
        Set ClasseObject.ActiveLabel = ctrl
        LabelCollection.Add ClasseObject
    End If

 Next ctrl

End Sub

Private Sub LabelHovered()
 ActiveLabel.BackColor = vbYellow
End Sub

cUserForm

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsUserForm As MSForms.UserForm
Private mActiveLabel As MSForms.Label
Private ObjLabel As New cLabels

'## Properties
Public Property Get UserFormValue() As MSForms.UserForm
    Set UserFormValue = clsUserForm
End Property

Public Property Set UserFormValue(Value As MSForms.UserForm)
    Set clsUserForm = Value
End Property

Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = mActiveLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set mActiveLabel = Value
End Property

'## Procedures
Private Sub clsUserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'MsgBox ObjLabel.ActiveLabel.BackColor 'Got an error
End Sub

Workbook: https://drive.google.com/file/d/1cLG4pLmC-jDaysjd_dK0EFuJ_LqYqJ-u/view?usp=sharing


Solution

  • I found your question very interesting and I've got a bit of a different, more object oriented take on how you might do this. I tried implementing an Observer Pattern to get the described effect. (As a side note, normally I would generalize a solution a bit more using Interfaces, but for this quick demo, I will show a couple of tightly coupled classes that get the job done)

    Allow me to first introduce all my components:

    Classes:

    LabelObserver

    Option Explicit
    
    Private WithEvents mInteralObj As MSForms.label
    Private mBackGroundColor As Long
    Private mMouseOverColor As Long
    
    Private Const clGREY As Long = &H8000000F
    
    '// "Constructor"
    Public Sub Init(label As MSForms.label, _
                    Optional mouseOverColor As Long = clGREY, _
                    Optional backGroundColor As Long = clGREY)
                    
        Set mInteralObj = label
        mBackGroundColor = backGroundColor
        mMouseOverColor = mouseOverColor
    End Sub
    
    Private Sub Class_Terminate()
        Set mInteralObj = Nothing
    End Sub
    
    Public Sub MouseLeft()
        '//Remove Highlight
        mInteralObj.BackColor = mBackGroundColor
    End Sub
    
    Private Sub mInteralObj_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        '//Highlight
        mInteralObj.BackColor = mMouseOverColor
    End Sub
    

    LabelNotifier

    Option Explicit
    Private observersCollection As Collection
    
    Private Sub Class_Initialize()
        Set observersCollection = New Collection
    End Sub
    
    Public Sub AddObserver(observer As LabelObserver)
        observersCollection.Add observer
    End Sub
    
    Public Sub RemoveObserver(observer As LabelObserver)
        Dim i As Long
        '// We have to search through the collection to find the observer to remove
        For i = 1 To observersCollection.Count
            If observersCollection(i) Is observer Then
                observersCollection.Remove i
                Exit Sub
            End If
        Next i
    End Sub
    
    Public Function ObserverCount() As Integer
        ObserverCount = observersCollection.Count
    End Function
    
    Public Sub Notify()
        Dim obs As LabelObserver
        
        If Me.ObserverCount > 0 Then
        
            For Each obs In observersCollection
                '//call each observer's MouseLeft method
                obs.MouseLeft
            Next obs
        
        End If
    End Sub
    
    Private Sub Class_Terminate()
        Set observersCollection = Nothing
    End Sub
    

    Module:

    LabelObserverFactory (this is kinda optional - it simply provides a nice streamlined way of creating valid LabelObservers)

    Option Explicit
    
    Public Function NewYellowHighlightCustomLabel(label As MSForms.label) As LabelObserver
        Dim product As New LabelObserver
        
        product.Init label, vbYellow
        
        Set NewYellowHighlightCustomLabel = product
    End Function
    
    Public Function NewRedHighlightCustomLabel(label As MSForms.label) As LabelObserver
        Dim product As New LabelObserver
        
        product.Init label, vbRed
        
        Set NewRedHighlightCustomLabel = product
    End Function
    

    UserForm

    MyForm (note that this form has three labels with default names placed on it for the purposes of this demo)

    Option Explicit
    
    Private notifier As LabelNotifier
    
    
    Private Sub UserForm_Initialize()
        Set notifier = New LabelNotifier
        
        '//add controls to be notified
        notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label1)
        notifier.AddObserver LabelObserverFactory.NewRedHighlightCustomLabel(Me.Label2)
        notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label3)
        
        
    End Sub
    
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        '//Notify labels that mouse has left them
        notifier.Notify
    End Sub
    
    Private Sub UserForm_Terminate()
        Set notifier = Nothing
    End Sub
    

    Now, to explain what's going on here:

    The form has a LabelNotifier object, which gets established when the form initializes, that it will use to notify our labels that the mouse has moved away from them. We do this by listening for the form's MouseMove event. (I know you are trying to avoid using this, but hopefully the fact that ours will just have one line of code, no matter how many labels you are impacting, will satisfy the desire to encapsulate logic elsewhere.) When we get a mouse move, we will have the notifier do its only job, to send a message to all the labels we added to it.

    The LabelObserver is the counter part of the LabelNotifier. A label observer is responsible for telling the labels to change color and which colors to use.

    Even if you don't like this implementation, I had fun making it. :-)