Mouse click event

[bhavesh78]

How can I write a mouse click event in the Worksheet_SelectionChange sub?

I want to execute a procedure only if user clicks the cell. Right now everytime i move the cursor, the Worksheet_SelectionChange gets triggered.

Thanks.

 

[tusharm]

AFAIK, there is no way to detect a mouse click in a cell. You could use the appropriate Windows API and subclassing to detect a mouse click, but I am not sure how you would then map that click onto a cell.

 

[Jaafar Tribak]

Subclassing XL is something that i always try to avoid as it has a bad inpact on performance.

Here is a solution without having to Subclass the Application. It basically checks for the worksheet navigation keys state when a cell(s) is selected.

If any of these keys is down, the Selection_Change event handler is simply skipped which means that the only time the event is triggered is when the a cell is selected with the mouse thus simulating a Mouse Click event.

I have wrapped the code in a Class for easy use.I named the class clsWorksheet_OnClick.

Here is a download showing a workbook whose worksheets were assigned to this Class: http://www.savefile.com/files/4179059


Here is the Class Code :

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public WithEvents Worksheet As Worksheet


Private Sub WorkSheet_SelectionChange(ByVal Target As Range)

    Dim lngArr As Variant
    Dim Item As Variant

    lngArr = Array(vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyTab, vbKeyReturn _
    , vbKeyHome, vbKeyEnd, vbKeyPageDown, vbKeyPageUp)
    
    '\ check if any of the navigation keys are pressed
    For Each Item In lngArr
        '\ if so, skip the event handler
        If CBool(GetAsyncKeyState(Item) And &H8000) Then
            Exit Sub
        End If
        
    Next
    '\ we got here means sheet has been navigated with the mouse
    '\ so execute event handler
    MsgBox "You Clicked Cell : " & Target.Address
    
    '\do your stuff here ...

End Sub

Here is a Test Procedure that uses the Class to hook all the worksheets in a Workbook :

Place in a Standard Module:

Option Explicit

Dim colWorksheets_OnClick_ As Collection

Sub test()

    Dim Sht As Worksheet
    Dim objWorksheet_OnClick As clsWorksheet_OnClick

    Set colWorksheets_OnClick_ = New Collection
    
    For Each Sht In ThisWorkbook.Worksheets
    
            Set objWorksheet_OnClick = New clsWorksheet_OnClick
            
            Set objWorksheet_OnClick.Worksheet = Sht
            
            colWorksheets_OnClick_.Add objWorksheet_OnClick
            
    Next
    
    Set objWorksheet_OnClick = Nothing

End Sub

Regards.

 

[tusharm]

Nice. Should have thought of it myself. I guess I got caught up on the "mouse click" part rather than focusing on the intent.

Subclassing XL is something that i always try to avoid as it has a bad inpact on performance.

Here is a solution without having to Subclass the Application. It basically checks for the worksheet navigation keys state when a cell(s) is selected.
{snip}

 

[bhavesh78]

Jaafar, thanks a lot ... your example works fine ... I had to remove - Public WithEvents Worksheet As Worksheet - though

Also, is it possible to stop executing the code on right click?

-BS

 

[Jaafar Tribak]

is it possible to stop executing the code on right click?

Detecting which Mouse button was clicked in a worksheet SelectionChange event is easily done if the application is subclassed or a Mouse hook is installed.Unfortunatly both technics have a bad impact on performance as I said earlier.

Setting a Boolean flag in the BeforeRightClick event doesn't work as this event seems to fire after the SelectionChange event.

An alternative that I've tested and which hopefully seems to work is by checking for the WM_MOUSEMOVE message when a Cell is Mouse-clicked.This is done via calling the PeekMessage API inside the Worksheet SelectionChange event.

Here is a download demo : http://www.savefile.com/files/5811853

Here is the new version of the clsWorksheet_OnClick Class :

Option Explicit

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

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Long

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Const WM_MOUSEMOVE = &H200
Private Const MK_RBUTTON = &H2
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2

Public WithEvents Worksheet As Excel.Worksheet


Private Sub WorkSheet_SelectionChange(ByVal Target As Range)

    Dim lngArr() As Variant
    Dim Item As Variant
    Dim lngXLhWnd As Long
    Dim mssg As MSG
    
    lngArr = Array(vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyTab, vbKeyReturn _
    , vbKeyHome, vbKeyEnd, vbKeyPageDown, vbKeyPageUp)
    
    '\ check if any of the navigation keys are pressed
    For Each Item In lngArr
    
        '\ if so, skip the event handler
        If CBool(GetAsyncKeyState(Item) And &H8000) Then
            Exit Sub
        End If
        
    Next
    
    '\ ok, we got here it means the sheet has been navigated with the mouse
    '\ so we are ready to execute the selection_change event handler.
    '\ but first,let's find out which mouse button was clicked.
    
    '\ get the XL app window handle
    lngXLhWnd = FindWindow("XLMAIN", Application.Caption)
    
    '\ check for the WM_MOUSEMOVE in the app window message queue
     PeekMessage mssg, lngXLhWnd, WM_MOUSEMOVE, WM_MOUSEMOVE, PM_NOREMOVE + PM_NOYIELD
     
     '\ if a WM_MOUSEMOVE is detected and the mouse right button
     '\ wasn't down then proceed with your code
     If mssg.message = WM_MOUSEMOVE And mssg.wParam <> MK_RBUTTON Then
        MsgBox "You Clicked Cell(s) : " & Target.Address
     End If
     
    '\...do your stuff here ...

End Sub

Here is a Test Procedure that uses the updated Class to hook all the worksheets in a Workbook :

Option Explicit

Dim colWorksheets_OnClick_ As Collection


Sub Test()

    Dim Sht As Worksheet
    Dim objWorksheet_OnClick As clsWorksheet_OnClick

    Set colWorksheets_OnClick_ = New Collection
    
    For Each Sht In ThisWorkbook.Worksheets
    
            Set objWorksheet_OnClick = New clsWorksheet_OnClick
            
            Set objWorksheet_OnClick.Worksheet = Sht
            
            colWorksheets_OnClick_.Add objWorksheet_OnClick
            
    Next
    
    Set objWorksheet_OnClick = Nothing

End Sub

'__________________________________________________

Sub UnHookWorksheets()

    Set colWorksheets_OnClick_ = Nothing


End Sub

Note that double clicking a Cell also triggers this custom OnClick event . Normally, this shoudn't happen but I haven't been able to avoid this so far.

Regards.

 

[cscraja]

Jaafar,

I am a novice as far as class modules are concerned. Can you help me with how to use this code please? I created a class module and copied the contents, as well as a regular module for the test sub. Nothing happens when i run the test macro.

regards
Raja

 

[Jaafar Tribak]

Raja,

Welcome to the board !

I am busy right now. I'll look into this later on .

Regards.

 

[Jaafar Tribak]

Jaafar,

I am a novice as far as class modules are concerned. Can you help me with how to use this code please? I created a class module and copied the contents, as well as a regular module for the test sub. Nothing happens when i run the test macro.

regards
Raja

Do you get an error ?

Did you name the Class Module : clsWorksheet_OnClick ?

Regards.

 

[Pankaja]

Subclassing XL is something that i always try to avoid as it has a bad inpact on performance.

Here is a solution without having to Subclass the Application. It basically checks for the worksheet navigation keys state when a cell(s) is selected.

If any of these keys is down, the Selection_Change event handler is simply skipped which means that the only time the event is triggered is when the a cell is selected with the mouse thus simulating a Mouse Click event.

I have wrapped the code in a Class for easy use.I named the class clsWorksheet_*******.

Here is a download showing a workbook whose worksheets were assigned to this Class: http://www.savefile.com/files/4179059


Here is the Class Code :

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public WithEvents Worksheet As Worksheet


Private Sub WorkSheet_SelectionChange(ByVal Target As Range)

    Dim lngArr As Variant
    Dim Item As Variant

    lngArr = Array(vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyTab, vbKeyReturn _
    , vbKeyHome, vbKeyEnd, vbKeyPageDown, vbKeyPageUp)
    
    '\ check if any of the navigation keys are pressed
    For Each Item In lngArr
        '\ if so, skip the event handler
        If CBool(GetAsyncKeyState(Item) And &H8000) Then
            Exit Sub
        End If
        
    Next
    '\ we got here means sheet has been navigated with the mouse
    '\ so execute event handler
    MsgBox "You Clicked Cell : " & Target.Address
    
    '\do your stuff here ...

End Sub

Here is a Test Procedure that uses the Class to hook all the worksheets in a Workbook :

Place in a Standard Module:

Option Explicit

Dim colWorksheets_*******_ As Collection

Sub test()

    Dim Sht As Worksheet
    Dim objWorksheet_******* As clsWorksheet_*******

    Set colWorksheets_*******_ = New Collection
    
    For Each Sht In ThisWorkbook.Worksheets
    
            Set objWorksheet_******* = New clsWorksheet_*******
            
            Set objWorksheet_*******.Worksheet = Sht
            
            colWorksheets_*******_.Add objWorksheet_*******
            
    Next
    
    Set objWorksheet_******* = Nothing

End Sub

Regards.

---------------------------------------------------------------------
Jaafar,

Thank you very much for your solution.
I have same problem as above.
I want to mark the cell only if it is selected with mouse click. I dont want to mark the cell if is selected with keyboard arrows or tab or pageup/down.

Your solution suits best for my problem,
but if i use this piece of code, SelectionChange event will not be called either with mouse click or with key navigation.

If i remove the line 'Public WithEvents Worksheet As Worksheet', SelectionChange event will be triggered but execution will not detect pressed key. i.e it will not enter inside the condition below even if the navigation key is pressed.
If CBool(GetAsyncKeyState(Item) And &H8000) Then
Exit Sub
End If


I don't no why it is happening so.
I am using excel 2003. Please help me.

Thank you!