Cursors :: How to load a custom cursor

Using the SetCustomCursor function, you can display a range of standard Windows cursors (pointers), or one of your own.

Just add the following code to a standard module.

Private Declare Function LoadCursorBynum Lib "user32" _
    Alias "LoadCursorA" ( _
        ByVal hinstance As Long, _
        ByVal lpCursorName As Long _
    ) As Long
Private Declare Function LoadCursorFromFile Lib _
    "user32" Alias "LoadCursorFromFileA" ( _
        ByVal lpFileName As String _
    ) As Long
Private Declare Function SetCursor Lib _
    "user32" ( _
        ByVal hCursor As Long _
    ) As Long

Public Enum CursorTypeEnum
    csrSPPSTARTING = 32650& ' Standard arrow and small hourglass
    csrARROW = 32512&       ' Standard arrow
    csrCROSS = 32515&       ' Crosshair
    csrIBEAM = 32513&       ' Text I-beam
    csrWAIT = 32514&        ' Hourglass
    csrUPARROW = 32516&     ' Vertical arrow
    csrSIZE = 32640&        ' Windows NT only: Four-pointed arrow
    csrICON = 32641&        ' Windows NT only: Empty icon
    csrSIZENWSE = 32642&    ' Double-pointed arrow pointing northwest and southeast
    csrSIZENESW = 32643&    ' Double-pointed arrow pointing northeast and southwest
    csrSIZEWE = 32644&      ' Double-pointed arrow pointing west and east
    csrSIZENS = 32645&      ' Double-pointed arrow pointing north and south
    csrSIZEALL = 32646&     ' Same as IDC_SIZE
    csrNO = 32648&          ' Slashed circle
    csrHELP = 32651&        ' Arrow and question mark
End Enum

Public Function SetCustomCursor(Optional sCursorPath As String = "None", _
			Optional lCursorType As CursorTypeEnum = 0)
    'Load a cursor using one of the cursor constants, or using a custom file path
    Dim lReturn As Long
    

    If lCursorType > 0 Then
        lReturn = LoadCursorBynum(0&, lCursorType)
    ElseIf sCursorPath <> "" Then
        lReturn = LoadCursorFromFile(sCursorPath)
    Else
        DoCmd.Beep
        MsgBox "You must supply either an Enum value," & vbCrLf & "or a file path.", _
            vbOKOnly + vbExclamation, "Argument missing"
    End If
    

    lReturn = SetCursor(lReturn)
End Function

Calling convention:

• SetCustomCursor , csrHelp
• SetCustomCursor "c:\Temp\MyCursor.ico", csrIcon