Hand Cursor for Label vba excel

Question

I'm developing an application with many controls. I want to change the mouse cursor when it passes over a Label. I took a look in the option but there you have a limited choice and not what I want. I tried also to upload a mouse icon but I faced two difficulties: the first one is finding an icon under license cc0 and the second one is that Excel doesn't accept the format that I found. Can you please help? Thanks in advance

Answer 1

You can use the Windows API to change the cursor appearance. I'm assuming this is in an Excel UserForm, so you can use the MouseMove event to know when the mouse is over the label.

Here's the code that you would add in the code behind in a form.

Option Explicit

'Api Declarations
Private Declare Function GetCursorInfo Lib "user32" (ByRef pci As CursorInfo) As Boolean
Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'You can use the default cursors in windows
Public Enum CursorTypes
    IDC_ARROW = 32512
    IDC_IBEAM = 32513
    IDC_WAIT = 32514
    IDC_CROSS = 32515
    IDC_UPARROW = 32516
    IDC_SIZE = 32640
    IDC_ICON = 32641
    IDC_SIZENWSE = 32642
    IDC_SIZENESW = 32643
    IDC_SIZEWE = 32644
    IDC_SIZENS = 32645
    IDC_SIZEALL = 32646
    IDC_NO = 32648
    IDC_HAND = 32649
    IDC_APPSTARTING = 32650
End Enum

'Needed for GetCursorInfo
Private Type POINT
    X As Long
    Y As Long
End Type

'Needed for GetCursorInfo
Private Type CursorInfo
    cbSize As Long
    flags As Long
    hCursor As Long
    ptScreenPos As POINT
End Type

'Event that handles knowing when the mouse is over the control
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    AddCursor IDC_HAND
End Sub

'To set a cursor
Private Function AddCursor(CursorType As CursorTypes)
    If Not IsCursorType(CursorType) Then
        SetCursor LoadCursor(0, CursorType)
        Sleep 200 ' wait a bit, needed for rendering
    End If
End Function

'To determine if the cursor is already set
Private Function IsCursorType(CursorType As CursorTypes) As Boolean
    Dim CursorHandle As Long: CursorHandle = LoadCursor(ByVal 0&, CursorType)
    Dim Cursor As CursorInfo: Cursor.cbSize = Len(Cursor)
    Dim CursorInfo As Boolean: CursorInfo = GetCursorInfo(Cursor)

    If Not CursorInfo Then
        IsCursorType = False
        Exit Function
    End If

    IsCursorType = (Cursor.hCursor = CursorHandle)
End Function