我正在做一些自动化工作,以进行重复的复制粘贴工作。有时服务器会很慢。那时我将使用下面的代码等待,直到光标等待变为正常
Option Explicit
Private Const IDC_WAIT As Long = 32514
Private Type POINT
x As Long
y As Long
End Type
Private Type CURSORINFO
cbSize As Long
flags As Long
hCursor As Long
ptScreenPos As POINT
End Type
Private Declare Function GetCursorInfo _
Lib "user32" (ByRef pci As CURSORINFO) As Boolean
Private Declare Function LoadCursor _
Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Function IsWaitCursor() As Boolean
' Get handle to wait cursor
Dim handleWaitCursor As Long
handleWaitCursor = LoadCursor(ByVal 0&, IDC_WAIT)
Dim pci As CURSORINFO
pci.cbSize = Len(pci)
' Retrieve information about the current cursor
Dim ret As Boolean
ret = GetCursorInfo(pci)
If ret = False Then
MsgBox "GetCursorInfo failed", vbCritical
Exit Function
End If
' Returns true when current cursor equals to wait cursor
IsWaitCursor = (pci.hCursor = handleWaitCursor)
End Function
上面的代码在MS Excel 2013 32位环境下对我来说效果很好。但是现在我正在使用64位MS Excel,并且上面的代码无法正常工作。有人告诉我需要做什么
答案 0 :(得分:1)
Private Const IDC_WAIT As Long = 32514
Private Type POINT
X As Long
Y As Long
End Type
Private Type CURSORINFO
cbSize As Long
flags As Long
hCursor As LongPtr
ptScreenPos As POINT
End Type
Private Declare PtrSafe 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 LongPtr
Public Function IsWaitCursor() As Boolean
' Get handle to wait cursor
Dim handleWaitCursor As LongPtr
handleWaitCursor = LoadCursor(ByVal 0&, IDC_WAIT)
Dim pci As CURSORINFO
pci.cbSize = Len(pci)
' Retrieve information about the current cursor
Dim ret As Boolean
ret = GetCursorInfo(pci)
If ret = False Then
MsgBox "GetCursorInfo failed", vbCritical
Exit Function
End If
' Returns true when current cursor equals to wait cursor
IsWaitCursor = (pci.hCursor = handleWaitCursor)
End Function
上面的代码对我有用。我将 Long 数据类型更改为 LongPtr