CODEWITHSUNDEEP
vbaexcel
icebird76
icebird76

Reputation: 762

How to record mouse clicks in Excel VBA?

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

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?

Upvotes: 0

Views: 13828

Answers (1)

Comintern
Comintern

Reputation: 22185

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.

But first:

DISCLAIMER

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...

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

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

In a Module:

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

Upvotes: 6

Related Questions