Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,806
- Office Version
- 2016
- Platform
- Windows
Hi all,
There are times when excel users need to detect when a cell is being mouse-clicked ... The worksheet Selection_Change event is often used for this purpose but it has two main problems :
A- it doesn't differenciate between keyboard and mouse selections
B- It doesn't work if the same cell is repeatedly clicked without first having activated another cell
The following small Class (C_CellClickEvent) uses the CommandBars _OnUpdate event in combination with a few API calls to overcome the issues mentioned above ... Once the Class is instantiated, the custom and easy-to-use Wb_CellClick(ByVal Target As Range) event handler located in the workbook module becomes available
Workbook Download demo
1- Here is the Class code : (Class name = C_CellClickEvent)
2- And here is an example of how to implement the Class : ( Code to be placed in the ThisWorkbook module)
Code Written and tested in Excel 2010 Win 10 (64bit)
There are times when excel users need to detect when a cell is being mouse-clicked ... The worksheet Selection_Change event is often used for this purpose but it has two main problems :
A- it doesn't differenciate between keyboard and mouse selections
B- It doesn't work if the same cell is repeatedly clicked without first having activated another cell
The following small Class (C_CellClickEvent) uses the CommandBars _OnUpdate event in combination with a few API calls to overcome the issues mentioned above ... Once the Class is instantiated, the custom and easy-to-use Wb_CellClick(ByVal Target As Range) event handler located in the workbook module becomes available
Workbook Download demo
1- Here is the Class code : (Class name = C_CellClickEvent)
Code:
Option Explicit
Private WithEvents CmBrasEvents As CommandBars
Private WithEvents wbEvents As Workbook
Event CellClick(ByVal Target As Range)
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare PtrSafe Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#Else
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#End If
Private kbArray As KeyboardBytes
Private oPrevSelection As Range
Private Sub Class_Initialize()
Set CmBrasEvents = Application.CommandBars
Set wbEvents = ThisWorkbook
GetKeyboardState kbArray
kbArray.kbByte(vbKeyLButton) = 1
SetKeyboardState kbArray
End Sub
Private Sub Class_Terminate()
Set CmBrasEvents = Nothing
Set wbEvents = Nothing
End Sub
Private Sub CmBrasEvents_OnUpdate()
Dim tpt As POINTAPI
On Error Resume Next
GetKeyboardState kbArray
If GetActiveWindow <> Application.hwnd Then Exit Sub
GetCursorPos tpt
If GetKeyState(vbKeyLButton) = 1 Then
If TypeName(ActiveWindow.RangeFromPoint(tpt.x, tpt.Y)) = "Range" Then
If oPrevSelection.Address = ActiveWindow.RangeFromPoint(tpt.x, tpt.Y).Address Then
RaiseEvent CellClick(Selection)
End If
End If
End If
kbArray.kbByte(vbKeyLButton) = 0
SetKeyboardState kbArray
End Sub
Private Sub wbEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Set oPrevSelection = Target
End Sub2- And here is an example of how to implement the Class : ( Code to be placed in the ThisWorkbook module)
Code:
Option Explicit
Private WithEvents Wb As C_CellClickEvent
Private Sub Workbook_Open()
Set Wb = New C_CellClickEvent
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Wb = Nothing
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Wb Is Nothing Then
Set Wb = New C_CellClickEvent
End If
End Sub
[B][COLOR=#008000]' Here is the Cell Click event handler[/COLOR][/B]
Private Sub Wb_CellClick(ByVal Target As Range)
With Target
.Font.Bold = True
.Font.Name = IIf(.Value = "", "Wingdings", "calibri")
.Value = IIf(.Value = "", "ü", "")
MsgBox "You clicked cell : " & vbLf & .Address(External:=True), vbInformation
End With
End SubCode Written and tested in Excel 2010 Win 10 (64bit)
Last edited:
ray:
