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!!!!

 

[JamesW]

Hi,

You can't use .ColorIndex, and .Underline is a BOOLEAN.
Try:

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

 

[iDeals]

Thank you!

That works well! How would I get it to reset when the mouse is no longer over the label?

 

[JamesW]

You could maybe do the same thing but assign it to the Form_MouseOver event.

 

[iDeals]

The label is actually embedded on the worksheet itself. Not sure if the form mouseover event would work.

 

[iDeals]

I changed it to this, but the reliability is a bit sketchy

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If y <= 5 Or y >= Label1.Height - 5 Or x <= 5 Or x >= Label1.Width - 5 Then
     Label1.ForeColor = 255
     Label1.Font.Underline = True
    Else
     Label1.ForeColor = 290
     Label1.Font.Underline = False
    End If
End Sub

 

[iDeals]

Is there any way that is more dependable. It often "sticks" on one format or another

 

[Jaafar Tribak]

The label control has no Mouse_Leave event but with a bit of imagination one could get the same smooth result as follows :

1- Place in a new Standard module :

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

2- Code in the Label Mouse_Move event :

Private Sub Label1_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
    
    Label1.ForeColor = 255
    Label1.Font.Underline = True
 
    Call WatchMouse(Label1)
 
End Sub

 

[iDeals]

Thank you! Jaafar you are a GENIUS!!!

Is there a way to apply this to all labels on the page? I tried just plugging it in and editing the label number, but on mousemove over additional labels it only changes the look of Label1.

 

[Jaafar Tribak]

Thank you! Jaafar you are a GENIUS!!!

Is there a way to apply this to all labels on the page? I tried just plugging it in and editing the label number, but on mousemove over additional labels it only changes the look of Label1.

You should be able to do this via a Class module.