html窗口变为活动状态,当包含excel实例的窗口变为活动状态时,检测(在VBA中)

我相信这不是直接在Excel中提供的,因此请使用

Windows API.你可以在VBA中进行win32编程！

说明

您可以使用win32 api函数SetWinEventHook让Windows向您报告某些事件.包括当前景窗口改变时触发的EVENT_SYSTEM_FOREGROUND.在下面的示例中,我根据Excel的进程ID检查新前景窗口的进程ID.这是一种简单的方法,但它会检测其他Excel窗口,如VBA窗口,与主Excel窗口相同.这可能是您想要的行为,也可能不是,可以相应更改.

您必须小心使用SetWinEventHook,因为您将回调函数传递给它.您在此回调函数中可以执行的操作受到限制,它存在于VBA正常执行之外,并且其中的任何错误都将导致Excel以混乱的不可恢复方式崩溃.

这就是我使用Application.OnTime报告事件的原因.如果比Excel和VBA更新更快地触发多个事件,则不会按顺序发生它们.但它更安全.您还可以更新一个集合或事件数组,然后在WinEventFunc回调之外单独读取它们.

示例代码

要对此进行测试,请创建一个新模块并将此代码粘贴到其中.然后运行StartHook.记得在关闭Excel或修改代码之前运行StopAllEventHooks !!在生产代码中,您可能会将StartEventHook和StopAllEventHooks添加到WorkBook_Open和WorkBook_BeforeClose事件中,以确保它们在适当的时间运行.请记住,如果在挂钩停止之前WinEventFunc VBA代码出现问题,Excel将崩溃.这包括正在修改的代码或关闭时所处的工作簿.当挂钩处于活动状态时,也不要在VBA中按停止按钮.停止按钮可以擦除当前的程序状态！

Option Explicit

Private Const EVENT_SYSTEM_FOREGROUND = &H3&

Private Const WINEVENT_OUTOFCONTEXT = 0

Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, _

ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, _

ByVal idThread As Long, ByVal dwFlags As Long) As Long

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Private pRunningHandles As Collection

Public Function StartEventHook() As Long

If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection

StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)

pRunningHandles.Add StartEventHook

End Function

Public Sub StopEventHook(lHook As Long)

Dim LRet As Long

If lHook = 0 Then Exit Sub

LRet = UnhookWinEvent(lHook)

End Sub

Public Sub StartHook()

StartEventHook

End Sub

Public Sub StopAllEventHooks()

Dim vHook As Variant, lHook As Long

For Each vHook In pRunningHandles

lHook = vHook

StopEventHook lHook

Next vHook

End Sub

Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _

ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _

ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long

'This function is a callback passed to the win32 api

'We CANNOT throw an error or break. Bad things will happen.

On Error Resume Next

Dim thePID As Long

If LEvent = EVENT_SYSTEM_FOREGROUND Then

GetWindowThreadProcessId hWnd, thePID

If thePID = GetCurrentProcessId Then

Application.OnTime Now, "Event_GotFocus"

Else

Application.OnTime Now, "Event_LostFocus"

End If

End If

On Error GoTo 0

End Function

Public Sub Event_GotFocus()

Sheet1.[A1] = "Got Focus"

End Sub

Public Sub Event_LostFocus()

Sheet1.[A1] = "Nope"

End Sub