Change Font Color in Label via MouseMove

[iDeals]

Hello, I'm trying to work out the code for changing the formatting and color of the font in a label via mousemove. I tried the following:

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
     Label1.Font.ColorIndex = 3
     Label1.Font.Underline
End Sub

but I get an error. Any ideas?

THANKS!!!!

 

[iDeals]

Ok so I am unsure of how to make it a class module. I poked around and found that the format is similar on class modules and they seem to use the call function, so presumably I would use that to call the event instead of the call in the Label1_MouseMove. Is that correct, if so would I put it the class module in "this workbook"? and keep the code provided above in the module? Sorry - I'm still quite new to VBA

 

[Jaafar Tribak]

1- Add a few activeX labels to Sheet1

2- Add a new Class to your Project , give it the name of C_Label via the VBE Properties window and place this code in its module :

Option Explicit

Public WithEvents lb As msforms.Label


Private Sub lb_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal x As Single, ByVal y As Single)

    lb.ForeColor = 255
    lb.Font.Underline = True
 
    Call WatchMouse(lb)

End Sub

3- Add a standard module to your Project and place the following code in it :

Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
 
Private Declare Function SetTimer _
Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer _
Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal nIDEvent As Long) As Long
 
 
Private oLabel As Object

Private Sub TimerProc()

    Dim tP As POINTAPI
    
    On Error Resume Next
    
    GetCursorPos tP
    
    If ActiveWindow.RangeFromPoint(tP.x, tP.y).Name <> oLabel.Name Then
        oLabel.ForeColor = 0
        oLabel.Font.Underline = False
        KillTimer Application.hwnd, 0
    End If

End Sub


Public Sub WatchMouse(lbl)

    Set oLabel = lbl

    KillTimer Application.hwnd, 0
    SetTimer Application.hwnd, 0, 1, AddressOf TimerProc

End Sub

4- Place this code in the Workbook module :

Option Explicit

Private oCol As Collection


Private Sub Workbook_Open()

    Dim oClss As C_Label
    Dim obj As Object
    
    Set oCol = New Collection
    For Each obj In Sheet1.OLEObjects
        If TypeOf obj.Object Is msforms.Label Then
            Set oClss = New C_Label
            Set oClss.lb = obj.Object
            oCol.Add oClss
            Set oClss = Nothing
        End If
    Next

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Set oCol = Nothing
    
End Sub

5- Save your workbook and run the WorkBook_Open event .


Once you have done the above steps, all the labels embeeded in Sheet1 will mimic a smooth MouseLeave event.

 

[iDeals]

Many thanks Jaafar - will plug that in now. I have an odd occurence this morning. When I open the spreadsheet with the previous code the font is now considerably smaller in the Labels. I checked the properties and it is still set to 11. That said when I click on them it further reduces the font in the labels until they are completely gone. Do you think I need to add a font size to the mouse move or should this be static?

 

[Jaafar Tribak]

Many thanks Jaafar - will plug that in now. I have an odd occurence this morning. When I open the spreadsheet with the previous code the font is now considerably smaller in the Labels. I checked the properties and it is still set to 11. That said when I click on them it further reduces the font in the labels until they are completely gone. Do you think I need to add a font size to the mouse move or should this be static?

I couldn't reproduce this font issue. so I am not sure.

 

[iDeals]

I'm wondering if it is due to the fact that I have a Click event on the Label as well. I will try removing variables to see if I can narrow down what is causing it. Thanks again for all your help!!

 

[Jaafar Tribak]

I'm wondering if it is due to the fact that I have a Click event on the Label as well. I will try removing variables to see if I can narrow down what is causing it. Thanks again for all your help!!

I added a click event code to see if it would affect the font but it didn't. what version of excel are you using ? I heard using activex controls in xl 2010 can be problematic.

 

[iDeals]

That is disheartening - just upgraded to 2010.

 

[Jaafar Tribak]

That is disheartening - just upgraded to 2010.

See if there are any office updates from MS help site.