如何在Excel VBA中记录鼠标点击？ [英] How to record mouse clicks in Excel VBA?

问题描述

我正在尝试制作一个记录用户点击的宏，然后记录鼠标坐标和点击之间的延迟。然后，会在其他 SendKey 更改后重复。当宏运行时，如何检测何时点击鼠标？我已经知道如何得到坐标和记录延迟，但是什么是检测鼠标点击的最佳方法是什么是保存所有这些信息的最佳方法？一个文本文件？以下是我使用的鼠标点击事件片段：

I am trying to make a macro that records what a user clicked, which then records the mouse coordinates and the delay between the clicks. This will then repeat after some other SendKey changes. How can I detect when I click the mouse when the macro is running? I already know how to get the coordinates and record the delay, but what is the best course of action for detecting the mouse click and also what would be the best way to save all this information? A text file? Here is a snippet of the mouse click events that I use:

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重播？

There is another macro that calls SingleClick where it moves to a constant x and y, clicks, does some magic, and returns to the position before the macro started. So to reiterate, is there a simple or easy to understand method to record multiple clicks and delays between clicks and replay them through Excel VBA?

推荐答案

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

This is theoretically possible to do, but you'd have to set a hook for WH_MOUSE_LL messages. The problem is that I seriously doubt that VBA can keep up with the volume of messages that are going to be coming through that pipe. It would be like trying drinking from a fire hose in VBA. If you really want to give it a shot, you can see if this works.

但是首先：

如果您设置此工作簿并将其打开，Excel将会停止响应。如果您打开VBE，它将确定停止响应。不要将其放在不能删除的电子表格中。完全准备好使用shift键打开它，以编辑代码。你被警告了。我对此不负任何责任。我比在事件处理程序中的 任何 代码尝试过更好。你很可能会崩溃Excel。你一定会碰撞VBE。你可能会崩溃任何东西或其他一切。

In all likelihood, Excel will stop responding if you set up this Workbook and open it. It will certainlly stop responding if you open the VBE. Do not put this in a spreadsheet that you can't afford to delete. Be fully prepared to have to open it with the shift key down to make edits to the code. You have been warned. I take no responsibility for what you do with this. I know better than to have tried it with any code in the event handler. You will likely crash Excel. You will certainly crash the VBE. You may crash anything or everything else.

应该覆盖它。所以...

That should cover it. So...

在一个叫HookHolder的类中：

In a class called 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

在ThisWorkbook中：

In ThisWorkbook:

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

这篇关于如何在Excel VBA中记录鼠标点击？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！