'Option Explicit
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 EnableWindow Lib "user32" _
(ByVal hwnd As Long, ByVal fEnable As Long) 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 UnhookWindowsHookEx _
Lib "user32" (ByVal hHook 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
Private Declare Function GetClassName _
Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () 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, _
ByVal lParam As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Integer, ByVal Source As Long, ByVal Length As Long)
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Const WA_ACTIVE As Long = 1
Private Const WA_INACTIVE As Long = 0
Private Const GWL_WNDPROC = -4
Private Const WM_INITDIALOG As Long = &H110
Private Const WM_ACTIVATE = &H6
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE = 5
Private lPrevWnd As Long
Private lhHook As Long
Private bHookEnabled As Boolean
Sub StartHook()
'install a cbt hook to monitor for the activation of a window
If Not bHookEnabled Then
lhHook = SetWindowsHookEx _
(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
bHookEnabled = True
Else
MsgBox "The Event is already active.", vbInformation
End If
End Sub
Sub TerminateHook()
'important to unhook when done!
UnhookWindowsHookEx lhHook
bHookEnabled = False
End Sub
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim sBuffer1 As String
Dim lRetVal As Long
'check if a window has been activated.
If idHook = HCBT_ACTIVATE Then
'if so,get it's class name.
sBuffer1 = Space(256)
lRetVal = GetClassName(wParam, sBuffer1, 256)
'check if it is a "bosa_sdm_XL9" window that is being activated
If Left(sBuffer1, lRetVal) = "bosa_sdm_XL9" Then
'make the 'Cell Formatting ' Dialog Modeless
'by enabling the main XL app window.
EnableWindow GetParent(wParam), 1
'subclass the 'Cell Formatting ' Dialog to intercept its Msgs.
lPrevWnd = SetWindowLong _
(wParam, GWL_WNDPROC, AddressOf CallBackProc)
'remove CBT hook
Call TerminateHook
End If
End If
'Call next hook
HookProc = CallNextHookEx(lhHook, idHook, ByVal wParam, ByVal lParam)
End Function
Private Function CallBackProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If Msg = WM_ACTIVATE Then
Select Case True
'if user activates the main XL app window
'set the keyboard focus back to XL
Case LOWORD(wParam) = WA_INACTIVE
SetFocus Application.hwnd '***** NOT WORKING !!!! *****
Case LOWORD(wParam) = WA_CLICKACTIVE Or _
LOWORD(wParam) = WA_ACTIVE
End Select
End If
CallBackProc = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
End Function
Private Function LOWORD(dw As Long) As Integer
CopyMemory LOWORD, VarPtr(dw), 2
End Function
