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

ice*_*d76 0 excel vba

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

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
Run Code Online (Sandbox Code Playgroud)

还有另一个宏调用SingleClick它移动到常量 x 和 y 的位置,单击,执行一些魔术,然后返回到宏开始之前的位置。那么重申一下,是否有一种简单或易于理解的方法来记录多次点击和点击之间的延迟并通过 Excel VBA 重放它们?

Com*_*ern 5

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

但首先:

免责声明

如果您设置并打开此工作簿,Excel 很可能会停止响应。如果您打开 VBE,它肯定会停止响应。不要将其放入您无法删除的电子表格中。做好充分准备,必须按下 Shift 键打开它才能对代码进行编辑。你被警告了。我对你用这个做什么不承担任何责任。我知道最好不要用事件处理程序中的任何代码尝试它。您可能会导致 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
Run Code Online (Sandbox Code Playgroud)

在本工作簿中:

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
Run Code Online (Sandbox Code Playgroud)

在一个模块中:

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
Run Code Online (Sandbox Code Playgroud)