Option Explicit
'====================
'Public Declarations.
'=====================
Public bXLIsHooked As Boolean
'====================
'Private Declarations.
'=====================
Private Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal MSG As Long, _
ByVal wParam As Long, _
lParam As WINDOWPOS) As Long
Private 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
Private 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 UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function InvalidateRect Lib "user32.dll" _
(ByVal hwnd As Long, ByVal lpRect As Long, _
ByVal bErase As Long) As Long
Private Const WH_CBT As Long = 5
Private Const HCBT_CREATEWND As Long = 3
Private Const GWL_WNDPROC As Long = -4
Private Const WM_WINDOWPOSCHANGING As Long = &H46
Private lCBTHook As Long
Private lPrevWndProc As Long
'====================
'Public Routines.
'=====================
Public Sub StartWatching()
'//Careful.- Don't set the hook more than once!
If bXLIsHooked Then Exit Sub
'//Reset Range and ListBox.
Range("b6").ClearContents
ActiveSheet.ListBox1.Clear
'//make sure our workbook is hooked.
CallByName Sheets(1), "wbEvents", VbSet, ThisWorkbook
'//Hook the 'EXCELF' hidden window.
If GetEXCELFHwnd = 0 Then
lCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, _
0, GetCurrentThreadId)
Else
lPrevWndProc = SetWindowLong _
(GetEXCELFHwnd, GWL_WNDPROC, AddressOf EXCELFWinProc)
End If
'//set our Public hook flag.
bXLIsHooked = True
End Sub
Public Sub StopWatching()
'//Cleaup.
UnhookWindowsHookEx lCBTHook
SetWindowLong GetEXCELFHwnd, GWL_WNDPROC, lPrevWndProc
bXLIsHooked = False
End Sub
'====================
'Private Routines.
'=====================
Private Function CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim sBuffer As String
Dim lRetVal As Long
Select Case idHook
'//Was a window created ?
Case Is = HCBT_CREATEWND
'//If so,is it the "EXCELF" window ?
sBuffer = Space(256)
lRetVal = GetClassName(wParam, sBuffer, 256)
If Left(sBuffer, lRetVal) = "EXCELF" Then
'//if so, we are done with the CBT hook.
UnhookWindowsHookEx lCBTHook
'//Now subclass this window to capture the
'//WM_WINDOWPOSCHANGING Msg.
lPrevWndProc = SetWindowLong _
(wParam, GWL_WNDPROC, AddressOf EXCELFWinProc)
End If
End Select
CBTProc = CallNextHookEx _
(lCBTHook, idHook, ByVal wParam, ByVal lParam)
End Function
Private Function EXCELFWinProc _
(ByVal hwnd As Long, ByVal MSG As Long, _
ByVal wParam As Long, lParam As WINDOWPOS) As Long
'//Ignore errors.
On Error Resume Next
Select Case MSG
Case WM_WINDOWPOSCHANGING
'//Update the listbox and range as the user
'//changes the Target worksheet selection.
Sheets(1).Range("b6") = Selection.Address '(False, False)
Sheets(1).ListBox1.AddItem _
Selection.Address '(False, False)
'//Redraw the application screen area.
InvalidateRect Application.hwnd, 0, 0
End Select
'process other msgs.
EXCELFWinProc = CallWindowProc _
(lPrevWndProc, hwnd, MSG, wParam, lParam)
End Function
Private Function GetEXCELFHwnd() As Long
Dim hwnd As Long
hwnd = FindWindow("EXCELF", vbNullString)
If hwnd = 0 Then
hwnd = FindWindowEx _
(Application.hwnd, 0, "EXCELF", vbNullString)
End If
GetEXCELFHwnd = hwnd
End Function
