如何在 Excel VBA 中记录鼠标点击？

Question

我正在尝试制作一个宏来记录用户点击的内容，然后记录鼠标坐标和点击之间的延迟。这将在其他一些SendKey 更改后重复。如何检测宏运行时单击鼠标的时间？我已经知道如何获取坐标并记录延迟，但是检测鼠标点击的最佳方法是什么，以及保存所有这些信息的最佳方法是什么？一个文本文件？这是我使用的鼠标点击事件的 sn-p：

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Public pos As POINTAPI ' Declare variable

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10

Public Sub SingleClick()
Dim xval, yval
xval = GetSetting("Will's Program Sheet", "DPS Calibration", "PROGRAM X")
yval = GetSetting("Will's Program Sheet", "DPS Calibration", "PROGRAM Y")
Select Case xval
Case Is = "" 'Runs calibrate if it can't find an xval
    Call CALIBRATE
    End
End Select
  SetCursorPos xval, yval  'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

还有另一个调用SingleClick 的宏，它移动到一个常数x 和y，点击，做一些魔术，然后返回到宏开始之前的位置。所以重申一下，是否有一种简单或易于理解的方法来记录多次点击和点击之间的延迟并通过 Excel VBA 重播？

Answer 1

这是理论上可以做到的，但您必须为 WH_MOUSE_LL 消息设置一个挂钩。问题是我严重怀疑 VBA 能否跟上将要通过该管道的消息量。这就像在 VBA 中尝试从消防水带中喝水一样。如果你真的想试一试，你可以看看这是否有效。

但首先：

免责声明

如果您设置并打开此工作簿，Excel 很可能会停止响应。如果您打开 VBE，它肯定会停止响应。不要将其放入您无法删除的电子表格中。做好充分准备，必须用 shift 键打开它才能对代码进行编辑。你被警告了。我对你用这个做的事情不承担任何责任。我知道最好不要在事件处理程序中使用 any 代码进行尝试。您可能会使 Excel 崩溃。您肯定会使 VBE 崩溃。您可能会崩溃任何东西或其他一切。

这应该涵盖它。所以...

在一个名为 HookHolder 的类中：

Option Explicit

Private hook As Long

Public Sub SetHook()
    hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf ClickHook, _
                            0, GetCurrentThreadId)
End Sub

Public Sub UnsetHook()
    'IMPORTANT: You need to release the hook when you're done with it.
    UnhookWindowsHookEx hook
End Sub

在本工作簿中：

Option Explicit

Private danger As HookHolder

Private Sub Workbook_Open()
    Set danger = New HookHolder
    danger.SetHook
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    danger.UnsetHook
End Sub

在一个模块中：

Option Explicit

Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
        ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
        ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const HC_ACTION As Long = 0
Public Const WH_MOUSE_LL As Long = &H2
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK  As Long = &H203

'Your callback function.
Public Function ClickHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If nCode = HC_ACTION Then
        'Anything in particular you're interest in?
        Select Case wParam
            Case WM_LBUTTONDOWN
                'Do your thing.
            Case WM_LBUTTONUP
                'Do your thing.
            Case WM_LBUTTONDBLCLK
                'Do your thing.
        End Select
    End If
    CallNextHookEx 0, nCode, wParam, ByVal lParam
End Function