'How to trap Left Click in Excel?

I want to know if the selection of a cell is caused by a cursor move or by a mouse action.

There are a lot of articles explaining how to trap mouse click in Excel, even some explaining that left click can be trapped.

This code is found many times on the web:

' The declaration tells VBA where to find and how to call the API
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
' The function returns whether a key (or mouse button) is pressed or not
Public Function KeyPressed(ByVal Key As Long) As Boolean
    KeyPressed = CBool((GetAsyncKeyState(Key) And &H8000) = &H8000)
End Function


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If (KeyPressed(&H1) = True) Then
        MsgBox "Left click"
    End If

    If (KeyPressed(&H2) = True) Then
        MsgBox "Right click"
    End If
        
End Sub

This code traps the right click event, but not the left! Probably because it is placed in the Worksheet_SelectionChange event which is only called when a SelectionChanged has occurred and therefore when the left button has already been released!

How to detect a left click on a cell of a sheet to know if the selection of a cell is caused by a keyboard input (arrows or enter) or by a mouse left/right click action?



Solution 1:[1]

I found this great article and adapt it for mouse button check : https://www.mrexcel.com/board/threads/keypress-event-for-worksheet-cells.181654/

Add this module:

Option Explicit

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

Declare Function CallNextHookEx Lib "user32" _
                                (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                            (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Const HC_ACTION = 0
Const WH_MOUSE_LL = 14                ' Type of windows message to be hooked
Const WM_RBUTTONDOWN = &H204          ' Mouse message for right button down
Const WM_LBUTTONDOWN = &H201          ' Mouse message for left button down

Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Dim hkLowLevelID As Long             ' Hook id of the LowLevelMouseProc function
Dim LeftMouseDown As Boolean         ' Flag to trap left mouse down events
Dim RightMouseDown As Boolean        ' Flag to trap left mouse down events
Dim EllapsedTimer As Date


Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long

On Error GoTo ResumeHere

    ' CAUTION !!!
    ' We can't do any action which envolves UI interaction because Excel is already beeing to update UI

    ' Hook mouse events only if XL is the active window
    If GetActiveWindow = FindWindow("XLMAIN", Application.Caption) Then
        If (nCode = HC_ACTION) Then
                        
            ' Check if the left button is pressed
            If (wParam = WM_LBUTTONDOWN) Then
                LeftMouseDown = True
                EllapsedTimer = Now() + TimeValue("00:00:01")
                Application.OnTime EllapsedTimer, "ResetFlags"
            
            ElseIf (wParam = WM_RBUTTONDOWN) Then
                RightMouseDown = True
                EllapsedTimer = Now() + TimeValue("00:00:01")
                Application.OnTime EllapsedTimer, "ResetFlags"
           
            End If
        End If
    End If
        
ResumeHere:
    ' Pass function to next hook if there is one
    LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)

End Function
        
        
Function isLeftMouseDown()
    isLeftMouseDown = LeftMouseDown
End Function

Function isRightMouseDown()
    isRightMouseDown = RightMouseDown
End Function

' Reset the flags if the click has been thrown too long ago
Sub ResetFlags()
    RightMouseDown = False
    LeftMouseDown = False
End Sub


' Call this proc when opening Workbook
Sub StartHook()

    If (hkLowLevelID = 0) Then
        ' Initiate the hooking process
        hkLowLevelID = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
    End If
    
End Sub


' Call this proc when closing Workbook
Sub StopHook()

    If hkLowLevelID <> 0 Then
        UnhookWindowsHookEx hkLowLevelID
        hkLowLevelID = 0
    End If

End Sub

It defines 2 procs StartHook and StopHook that you use in "ThisWoorkbook":

Private Sub Workbook_Open()
    Call StartHook
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopHook
End Sub

And 2 functions that you can use in the macro for the Sheets like this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    ' Check if the mouse Left button was pressed
    If (isLeftMouseDown()) Then
    
        ... do some stuff on left click - for example ...
        If (ActiveCell.Column = 1) Then
            MsgBox "You LeftClick in column A"
        End If
        ...
    
    End If

End Sub

Caution :

  • The flag can be read for 1 second after the click event, they are then reseted. That is to prevent some side effect when leaving excel and coming back to it.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1