Userform Hand Mouse Icon when scroll over buttons

[Chris Macro]

I have been trying to figure out how to change my mouse icon when I scroll over a clickable button on my userform. I want the hand icon (because that's what makes sense to me) but the drop down on the MousePointer properties doesn't have one. I also tried uploading an icon from my Windows cursor folder (inside the MouseIcon property) but I don't think VBA excepts the file format. Any ideas on how to accomplish this?

 

[Norie]

Did you change the MousePointer property to 99 - frmMousePointerCustom?

 

[Chris Macro]

yeah, when I try to upload the image I get a message-box saying the the picture is not valid. I'm guessing it's because it's a .cur file???

 

[Norie]

How did you try uploading the picture?

 

[Chris Macro]

I clicked in the MouseIcon properties field and got a dialogue box to find the file. I found the file and clicked open. I then got the msgbox saying it was an invalid picture.

 

[shg]

Does it work with other picture file formats (.jpg, .bmp, ...)?

 

[Chris Macro]

I just got it to work with a .ico picture that I found. I'm guessing it is the format of .cur that was causing the problem. With mouse cursors I'm not going to want a background visible so I want to go with a .png, .ico, .cur type file format....its just hard to find those (with a clear background) unless you make it yourself. Its unfortunately that I have a whole library of cursors on my computer and can't use them.

 

[Jaafar Tribak]

Sometime ago I needed to display the standard HAND cursor when pointing the mouse over a userform commandbutton but proved very difficult as I couldn't find it in the list of mouse pointers and excel wouldn't allow me to choose from the cursors *.cur or *.ico that i had in the windows folder.

So I decided to write this generic code to assign each commandbutton its own custom cursor including the Hand cursor of course.... Executing the simple following line upon initializing the userform does the job :

 Call ChangeCursor(CommandButton1, ICONS.IDC_HAND)

Workbook Demo


Anyway here is the Class code for future reference ( The class name is : CButtonCursors)

Option Explicit
 
Public WithEvents cmb As CommandButton

Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
 
Private Declare Function WaitMessage Lib "user32" _
() As Long
 
Private Declare Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Private Declare Function GetCursorPos Lib "user32.dll" _
(ByRef lpPoint As POINTAPI) As Long
 
Private Declare Function SetCursor Lib "user32" _
(ByVal hCursor As Long) As Long
 
Private Declare Function LoadCursor Lib "user32.dll" _
Alias "LoadCursorA" _
(ByVal hInstance As Long, _
ByVal lpCursorName As Long) As Long
 
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Const PM_NOREMOVE As Long = &H0
Private Const WM_SETCURSOR As Long = &H20

Private bMouseHooked As Boolean
Private bStop As Boolean
Private bCurOverButton As Boolean

Private lCur As Long
Private oFrm As UserForm

Public Sub ChangeCurOf(frm As UserForm, ByVal Button As CommandButton, ByVal Cur As Long)
    Dim tMsg As MSG
    Dim tPt As POINTAPI
    Dim lCurID As Long
    Dim hwnd As Long
    If bMouseHooked Then Exit Sub
    bMouseHooked = True
    bStop = False
    lCur = Cur
    Set oFrm = frm
    hwnd = _
    FindWindow(vbNullString, frm.Caption)
    If Not bCurOverButton Then Exit Sub
    Do
        GetCursorPos tPt
        If WindowFromPoint(tPt.X, tPt.Y) <> hwnd Then bStop = True
        SetCursor LoadCursor(0, Cur)
        WaitMessage
        If PeekMessage _
        (tMsg, hwnd, _
        WM_SETCURSOR, WM_SETCURSOR, PM_NOREMOVE) Then
            PostMessage hwnd, WM_SETCURSOR, 0, 0
        End If
        DoEvents
    Loop Until bStop
End Sub


Private Sub cmb_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    bStop = True
    bMouseHooked = False
    bCurOverButton = True
    Call ChangeCurOf(oFrm, cmb, lCur)
End Sub

And this how you use the class ( Code in the UserFom module )

Option Explicit
Enum ICONS
    IDC_HAND = 32649&
    IDC_SIZEALL = 32646&
    IDC_SIZE = 32640&
    IDC_APPSTARTING = 32650&
    IDC_ICON = 32641&
    IDC_WAIT = 32514&
    IDC_IBEAM = 32513&
    IDC_CROSS = 32515&
    IDC_UPARROW = 32516&
End Enum

[COLOR=#008000]'Change the cur of 4 CommandButtons[/COLOR]
Private Sub UserForm_Initialize()
    Call ChangeCursor(CommandButton1, ICONS.IDC_HAND)
    Call ChangeCursor(CommandButton2, ICONS.IDC_APPSTARTING)
    Call ChangeCursor(CommandButton3, ICONS.IDC_SIZEALL)
    Call ChangeCursor(CommandButton4, ICONS.IDC_CROSS)
End Sub

Private Sub ChangeCursor(ByVal Button As CommandButton, ByVal Cur As ICONS)
    Static ar() As CButtonCursors
    Static i As Long
    ReDim Preserve ar(i)
    Set ar(i) = New CButtonCursors
    Set ar(i).cmb = Button
    Call ar(i).ChangeCurOf(Me, Button, Cur)
    i = i + 1
End Sub