Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,775
- Office Version
- 2016
- Platform
- Windows
Hi,
As we know, for some stupid reason, Excel has no built-in Left Mouse Button click event that the programmer can capture in code.
Well, below is an attempt to create such an event using subclassing.
In this example , the code makes it possible for the user to mark with an "X" all the cells within the range "D6:H16" just by selecting them and left clicking the Mouse.
I beleive there must be a simpler/shorter way of doing this.
Any ideas are most welcome.
Code:
Place this code in the WorkSheet Module :
<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> TargetValue <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeDoubleClick _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)
<SPAN style="color:#007F00">' Restoring initial cell value</SPAN>
Target.Value = TargetValue
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeRightClick _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)
<SPAN style="color:#007F00">' Restoring initial cell value</SPAN>
Target.Value = TargetValue
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_SelectionChange _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)
<SPAN style="color:#00007F">Dim</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> HookResult <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#007F00">' Storing initial cell value</SPAN>
TargetValue = Target
<SPAN style="color:#00007F">If</SPAN> Union(Target, Range("D6:H16")).Address = _
Range("D6:H16").Address <SPAN style="color:#00007F">Then</SPAN>
hwnd = FindWindow("XLMAIN", Application.Caption)
HookResult = Hook(hwnd)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>
And this code in a Standard Module :
<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> SetWindowLong Lib _
"user32" Alias "SetWindowLongA" _
(<SPAN style="color:#00007F">ByVal</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> nIndex <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal dwNewLong <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> CallWindowProc Lib _
"user32" Alias "CallWindowProcA" _
(<SPAN style="color:#00007F">ByVal</SPAN> lpPrevWndFunc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal Msg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ByVal wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal lParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> uMsg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Const</SPAN> WM_LBUTTONDOWN = 32
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Const</SPAN> GWL_WNDPROC = -4
<SPAN style="color:#00007F">Public</SPAN> ghWnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> lpPrevWndProc <SPAN style="color:#00007F">As</SPAN> Long
<SPAN style="color:#00007F">Public</SPAN> RC <SPAN style="color:#00007F">As</SPAN> Long
<SPAN style="color:#007F00">'Hooking the Left Mouse Click</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> Hook(hnWnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
ghWnd = hnWnd
lpPrevWndProc = SetWindowLong _
(ghWnd, GWL_WNDPROC, AddressOf WindowProc)
Hook = 0
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#007F00">'Call back procedure</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> WindowProc _
(<SPAN style="color:#00007F">ByVal</SPAN> hw <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> uMsg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ByVal lParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">If</SPAN> uMsg = WM_LBUTTONDOWN <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">With</SPAN> ActiveCell
.Value = "X"
.Characters.Font.Bold = <SPAN style="color:#00007F">True</SPAN>
.HorizontalAlignment = xlCenter
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
WindowProc = CallWindowProc _
(lpPrevWndProc, hw, uMsg, wParam, lParam)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
unHook
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> unHook() <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
RC = SetWindowLong(ghWnd, GWL_WNDPROC, lpPrevWndProc)
unHook = RC
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>
Regards.
As we know, for some stupid reason, Excel has no built-in Left Mouse Button click event that the programmer can capture in code.
Well, below is an attempt to create such an event using subclassing.
In this example , the code makes it possible for the user to mark with an "X" all the cells within the range "D6:H16" just by selecting them and left clicking the Mouse.
I beleive there must be a simpler/shorter way of doing this.
Any ideas are most welcome.
Code:
Place this code in the WorkSheet Module :
<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> TargetValue <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeDoubleClick _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)
<SPAN style="color:#007F00">' Restoring initial cell value</SPAN>
Target.Value = TargetValue
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeRightClick _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)
<SPAN style="color:#007F00">' Restoring initial cell value</SPAN>
Target.Value = TargetValue
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_SelectionChange _
(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)
<SPAN style="color:#00007F">Dim</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> HookResult <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#007F00">' Storing initial cell value</SPAN>
TargetValue = Target
<SPAN style="color:#00007F">If</SPAN> Union(Target, Range("D6:H16")).Address = _
Range("D6:H16").Address <SPAN style="color:#00007F">Then</SPAN>
hwnd = FindWindow("XLMAIN", Application.Caption)
HookResult = Hook(hwnd)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>
And this code in a Standard Module :
<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> SetWindowLong Lib _
"user32" Alias "SetWindowLongA" _
(<SPAN style="color:#00007F">ByVal</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> nIndex <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal dwNewLong <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> CallWindowProc Lib _
"user32" Alias "CallWindowProcA" _
(<SPAN style="color:#00007F">ByVal</SPAN> lpPrevWndFunc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> hwnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal Msg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ByVal wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal lParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> uMsg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Const</SPAN> WM_LBUTTONDOWN = 32
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Const</SPAN> GWL_WNDPROC = -4
<SPAN style="color:#00007F">Public</SPAN> ghWnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Public</SPAN> lpPrevWndProc <SPAN style="color:#00007F">As</SPAN> Long
<SPAN style="color:#00007F">Public</SPAN> RC <SPAN style="color:#00007F">As</SPAN> Long
<SPAN style="color:#007F00">'Hooking the Left Mouse Click</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> Hook(hnWnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
ghWnd = hnWnd
lpPrevWndProc = SetWindowLong _
(ghWnd, GWL_WNDPROC, AddressOf WindowProc)
Hook = 0
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#007F00">'Call back procedure</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> WindowProc _
(<SPAN style="color:#00007F">ByVal</SPAN> hw <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> uMsg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
ByVal wParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ByVal lParam <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">If</SPAN> uMsg = WM_LBUTTONDOWN <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">With</SPAN> ActiveCell
.Value = "X"
.Characters.Font.Bold = <SPAN style="color:#00007F">True</SPAN>
.HorizontalAlignment = xlCenter
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
<SPAN style="color:#00007F">Else</SPAN>
WindowProc = CallWindowProc _
(lpPrevWndProc, hw, uMsg, wParam, lParam)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
unHook
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> unHook() <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
RC = SetWindowLong(ghWnd, GWL_WNDPROC, lpPrevWndProc)
unHook = RC
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>
Regards.