如何在vba中用钩子hook监视鼠标操作？

在如何在vba中使用Hook钩子？一文中我们介绍了钩子的含义，以及如何在vba中使用钩子。

本文介绍在vba中用钩子hook监视鼠标的操作。

用钩子hook监视鼠标的操作，首先要安装鼠标钩子WH_MOUSE。

由于鼠标的消息种类较多，可以有左键单击、右键单击、滚轮滑动等，具体的消息类型如下：

鼠标消息类型

以下代码是利用钩子hook监视鼠标操作的代码：

Public hHook 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 Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Const WH_KEYBOARD = 2
Public Const WH_MOUSE = 7
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A
Sub BeginHK()
    '获取当前的线程ID
    i = GetCurrentThreadId
    '这里安装的是键盘钩子
    hHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, 0, i)
End Sub
'Hook程序
Public Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '如果code参数＜0，则一定要返回CallNextHookEx函数的返回值
    If code < 0 Then
        HookProc = CallNextHookEx(hHook, code, wParam, lParam)
    Else
        Dim oWK As Worksheet
        Set oWK = Excel.ActiveSheet
        i = 2
        Select Case wParam
            Case WM_LBUTTONDOWN
                oWK.Cells(i, 2) = "你按下了鼠标左键"
            Case WM_RBUTTONDOWN
                oWK.Cells(i, 2) = "你按下了鼠标右键"
            Case WM_MBUTTONDOWN
                oWK.Cells(i, 2) = "你按下了鼠标中键"
            Case WM_MOUSEWHEEL
                oWK.Cells(i, 2) = "你滑动了鼠标滚轮"
            Case WM_MOUSEMOVE
                oWK.Cells(i, 2) = "你移动了鼠标"
        End Select
       '如果要拦截处理消息，则HookProc函数的返回值一定要是非0，不然会陷入死循环
        HookProc = 1
    End If
End Function
Sub EndHK()
    UnhookWindowsHookEx hHook
End Sub