据我所知,VBA 中没有这样的事件。来自文档:
只有在您移动焦点时才会发生激活和停用事件
在一个应用程序中。将焦点移入或移出
另一个应用程序不会触发任何一个事件。
但是,Windows API 可以使用 hook 处理事件。 VBA 中 Win API 的问题在于 VBA 不处理错误,因此如果/当代码遇到错误时 Excel 将崩溃;所以他们可能会让开发人员感到沮丧。从纯粹个人的角度来看,我喜欢将钩子过程中的代码保持在最低限度,并将任何值传递给可以触发事件的类——这至少可以最大限度地减少崩溃。记住在完成会话之前解开钩子也很重要。
Win API 挂钩的基本实现如下所示:
在类对象中(这里称为 cHookHandler)
Option Explicit
Public Event HookWindowActivated()
Public Event HookIdChanged()
Private mHookId As LongPtr
Private mTargetWindows As Collection
Public Property Get HookID() As LongPtr
HookID = mHookId
End Property
Public Property Let HookID(RHS As LongPtr)
mHookId = RHS
RaiseEvent HookIdChanged
End Property
Public Sub AttachHook()
modHook.AttachHook Me
End Sub
Public Sub DetachHook()
modHook.DetachHook
End Sub
Public Sub AddTargetWindow(className As String, Optional windowTitle As String)
Dim v(1) As String
'Creates an array of [0 => className, 1=> windowTitle]
'which is stored in a collection and tested for in
'your hook callback.
v(0) = className
v(1) = windowTitle
mTargetWindows.Add v
End Sub
Public Sub TestForTargetWindowActivated(className As String, windowTitle As String)
Dim v As Variant
'Tests if the callback window is one that we're after.
For Each v In mTargetWindows
If v(0) = className Then
If v(1) = "" Or v(1) = windowTitle Then
'Fires the event that our target window has been activated.
RaiseEvent HookWindowActivated
Exit Sub
End If
End If
Next
End Sub
Private Sub Class_Initialize()
Set mTargetWindows = New Collection
End Sub
Private Sub Class_Terminate()
modHook.DetachHook
End Sub
模块代码(这里的模块称为modHook)
Option Explicit
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, _
ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
(ByVal hHook As LongPtr, _
ByVal ncode As Long, _
ByVal wParam As LongPtr, _
lParam As Any) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As LongPtr, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As LongPtr, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private mHookHandler As cHookHandler
Public Sub AttachHook(hookHandler As cHookHandler)
Set mHookHandler = hookHandler
mHookHandler.HookID = SetWindowsHookEx(WH_CBT, AddressOf CBTCallback, 0, GetCurrentThreadId)
End Sub
Private Function CBTCallback(ByVal lMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Dim className As String, windowTitle As String
If mHookHandler Is Nothing Then Exit Function
If lMsg = HCBT_ACTIVATE Then
className = GetClassText(wParam)
windowTitle = GetWindowTitle(wParam)
If Not mHookHandler Is Nothing Then
mHookHandler.TestForTargetWindowActivated className, windowTitle
End If
End If
CBTCallback = CallNextHookEx(mHookHandler.HookID, lMsg, ByVal wParam, ByVal lParam)
End Function
Public Sub DetachHook()
Dim ret As Long
If mHookHandler Is Nothing Then Exit Sub
ret = UnhookWindowsHookEx(mHookHandler.HookID)
If ret = 1 Then
mHookHandler.HookID = 0
End If
End Sub
Private Function GetWindowTitle(wParam As LongPtr) As String
Dim tWnd As String
Dim lWnd As Long
tWnd = String(100, Chr(0))
lWnd = GetWindowText(wParam, tWnd, 100)
tWnd = Left(tWnd, lWnd)
GetWindowTitle = tWnd
End Function
Private Function GetClassText(wParam As LongPtr) As String
Dim tWnd As String
Dim lWnd As Long
tWnd = String(100, Chr(0))
lWnd = GetClassName(wParam, tWnd, 100)
tWnd = Left(tWnd, lWnd)
GetClassText = tWnd
End Function
在这个例子中,所有的事件都在Userform
在这个简单的示例中,Userform 上的两个按钮附加和分离钩子,但您可能会从其他地方调用例程(可能是用户窗体 Initialize 和 Terminate 事件)。 Userform 也有一个标签 lblHook 显示我在开发过程中使用的 HookId - 对于生产代码,你可能不想要这个,所以你可以省略那个。
Option Explicit
Private WithEvents mHookHandler As cHookHandler
Private Sub btnHook_Click()
mHookHandler.AttachHook
End Sub
Private Sub btnUnhook_Click()
mHookHandler.DetachHook
End Sub
Private Sub mHookHandler_HookIdChanged()
lblHook.Caption = mHookHandler.HookID
End Sub
Private Sub mHookHandler_HookWindowActivated()
' Caveat: this routine will crash if halted in debugger.
Debug.Print "I've been activated!"
End Sub
Private Sub UserForm_Initialize()
Set mHookHandler = New cHookHandler
mHookHandler.AddTargetWindow "ThunderDFrame", Me.Caption
End Sub
Private Sub UserForm_Terminate()
Set mHookHandler = Nothing
End Sub