标签的手形光标 vba excel

Question

我正在开发一个有很多控件的应用程序。我想在经过标签时更改鼠标光标。我看了一下选项，但你的选择有限，而不是我想要的。我也尝试上传一个鼠标图标，但我遇到了两个困难：第一个是在许可证 cc0 下找到一个图标，第二个是 Excel 不接受我找到的格式。你能帮忙吗？提前致谢

Answer 1

您可以使用 Windows API 更改光标外观。我假设这是在 Excel 用户窗体中，因此您可以使用 MouseMove 事件来了解鼠标何时位于标签上。

这是您要在表单后面的代码中添加的代码。

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

标签的手形光标 vba excel

Hand Cursor for Label vba excel

excel

vba

userform