Excel 有没有办法通过VBA中的winapi重写游标行为？

我想在excel宏运行时更改光标图像。我设法通过这些winapi函数更改光标：和

以下是一个例子：

Option Explicit

Declare Function LoadCursorFromFileA Lib "user32" (ByVal lpFileName As String) As Long
Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Sub TestCursor()
     Call SetCursor(LoadCursorFromFileA("C:\Temp\cursor2.cur"))
    ' Waits 5 seconds, any movement of the mouse will revert the cursor back to default
    Application.Wait Now + TimeValue("00:00:05")
    ' Cursor is back to default at the end of the sub
End Sub

但是，如果有事件（如对话框窗口）或光标移动，光标将变回默认值

看起来Excel在将光标悬停在元素上时会更新光标

我找到了一个，但它阻止了我的宏运行，因为它使用了无限循环

---

是否有方法覆盖Excel与光标的交互方式？

这是一些示例子类化代码。在Excel

Application.hWnd

中有您想要的hWnd

Public Const WM_SETCURSOR = &H20

当您收到上述消息时，返回True（-1）以停止游标中的进一步更改

gWindowProc = true

---

评论

当窗口进入菜单模式时，LPRAM的高阶字为零。 DefWindowProc函数将WM_SETCURSOR消息传递给父级 处理前打开窗口。如果父窗口返回TRUE，则进一步 处理已停止。将消息传递到窗口的父窗口 使父窗口可以控制子窗口中光标的设置 窗DefWindowProc函数还使用此消息设置 光标指向箭头（如果不在客户端区域），或指向 注册类游标（如果在客户端区域）。如果低阶 lParam参数的字是HTERROR，而 lParam指定按下一个鼠标按钮， DefWindowProc调用MessageBeep函数

---

MSDN 2001

您到底想做什么？在我看来，劫持WM消息来完全控制鼠标指针是太过分了。许多超出您控制范围的内容会将WM消息发送到消息循环中，以更改光标的外观。无限循环在某种程度上是合理的，因为替代方案涉及子类化（即自己进入Windows Messeng循环）。。。这不是日常VBA代码中通常要做的事情。“当我的宏运行时”不是很清楚。。您正在尝试将光标更改为沙漏吗？请参见应用程序。光标然后。否则祝你好运用我能说的最简单的方式：我想在宏工作时（主要是计算和格式化）使用自定义图像替换光标。我设法将光标更改为自定义图像，但Excel中有一些更新将其恢复为默认光标。我知道

Application.Cursor

，但它不支持自定义图像。我知道这可能有点过头了，但在这一点上，这只是出于好奇和学习一些更复杂的方法来使用VBA.Hmm。这是我选择不打的一场战斗（在VBA中，子类化相当脆弱），只要在宏运行时使用

Application.Cursor=xlWait

。如果您只需要光标用于<代码> UserForm <代码>，请考虑在“使用自定义鼠标指针”下建议修改<代码> MousePointer < /代码>属性。谢谢，这非常有帮助并且几乎可以工作。如果光标位于功能区上，效果会很好，但如果光标位于窗口（Excel的内部窗口）上，光标将恢复为默认值。看起来windows发送了他们自己的消息，我无法使用应用程序句柄截获它。我试图使用窗口句柄，但出现

错误438:对象不支持此属性或方法

。请参阅关于

peek消息（）

。或者创建一个设置光标的100毫秒计时器。

Public Sub Hook()
   lpPrevWndProc = SetWindowLong(EditNote.gRtfHwnd, GWL_WNDPROC, _
   AddressOf gWindowProc)
End Sub

Public Sub Unhook()
   Dim temp As Long
   temp = SetWindowLong(EditNote.gRtfHwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Function gWindowProc(ByVal hwnd As Long, ByVal Msg As Long, _
                 ByVal wParam As Long, ByVal lParam As Long) As Long
   If Msg = WM_CONTEXTMENU Then
        If EditNote.mnuViewEditContextMenu.Checked Then EditNote.PopupMenu EditNote.mnuEdit
'        gWindowProc = CallWindowProc(lpPrevWndProc, hWnd, Msg, wParam, _
         lParam)
   Else ' Send all other messages to the default message handler
      gWindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, _
         lParam)
   End If
End Function