检测（在 VBA 中）包含 excel 实例的窗口何时变为活动状态

Question

提问by Cool Blue

I can see the WindowActivateevents firing, at various levels, when I switch between windows within excel, but is there a way to fire an event when excel becomes the foreground application? If I click out of excel and work, for example in the browser for a while and then click back onto an excel window, I don't see any events firing. Is there any way to detect this?

WindowActivate当我在 excel 中的窗口之间切换时，我可以看到不同级别的事件触发，但是当 excel 成为前台应用程序时，有没有办法触发事件？如果我单击退出 excel 并工作，例如在浏览器中一段时间，然后单击返回到 excel 窗口，我看不到任何事件触发。有没有办法检测到这一点？

I would like to refresh some elements of my VBA application because, occasionally, I find that my Mouse Over feature, based on Hypertext Function, loses its ability to Activate charts. I can fix it by un-protecting and protecting the worksheet, or by trashing and re-initialising a subset of my objects. I would like trigger this action on the event that I am looking for.

我想刷新 VBA 应用程序的某些元素，因为有时我发现基于超文本功能的鼠标悬停功能失去了激活图表的能力。我可以通过取消保护和保护工作表来修复它，或者通过删除和重新初始化我的对象子集来修复它。我想在我正在寻找的事件上触发此操作。

I can also do this by SendKeysbut it's not nice because it wipes out the keyboard settings (e.g. scroll lock) due to a documented bug in SendKeysand it makes the screen flicker more than I would like.

我也可以这样做，SendKeys但这并不好，因为它会由于记录的错误而清除键盘设置（例如滚动锁定），SendKeys并且它使屏幕闪烁得比我想要的要多。

Since the code will reside in VBA I would limit the action to a particular workbook. If a different (passive) workbook is active when entering the Excel instance Window, then no action would be triggered and I can use the WorkbookActivateevent to refresh the application if and when the user selects the workbook containing it.

由于代码将驻留在 VBA 中，因此我会将操作限制为特定工作簿。如果在进入 Excel 实例窗口时另一个（被动）工作簿处于活动状态，则不会触发任何操作WorkbookActivate，如果用户选择包含它的工作簿，我可以使用该事件刷新应用程序。

Answer 1

回答by AndASM

I believe this is not provided in Excel directly, so use the Windows API. You can do win32 programming in VBA!

我相信这不是直接在 Excel 中提供的，所以使用 Windows API。你可以在VBA中进行win32编程！

Explanation

解释

You can use the win32 api function SetWinEventHookto get Windows to report certain events to you. Including EVENT_SYSTEM_FOREGROUND which is triggered when the foreground window changes. In the below example I check the new foreground window's process id against Excel's process id. This is a simple way to do it, but it will detect other Excel windows such as the VBA window the same as the main Excel window. This may or may not be the behavior you want and can be changed accordingly.

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

You have to be careful using SetWinEventHook, as that you pass a callback function to it. You are limited in what you can do in this callback function, it exists outside of VBA's normal execution and any errors inside it will cause Excel to crash in a messy unrecoverable way.

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

That's why I use Application.OnTime to report the events. They aren't gaurenteed to occur in order if multiple events are triggered more rapidly than Excel and VBA update. But it's safer. You could also update a collection or array of events, then read those back seperately outside of the WinEventFunc callback.

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

Example Code

示例代码

To test this, create a new module and paste this code into it. Then run StartHook. Remember to run StopAllEventHooks before closing Excel or modifying the code!!In production code you'd probably add StartEventHook and StopAllEventHooks to the WorkBook_Open and WorkBook_BeforeClose events to ensure they get run at the appropriate times. Remember, if something happens to the WinEventFunc VBA code before the hook is stopped Excel will crash. This includes the code being modified or the workbook it is housed in being closed. Also do notpress the stop button in VBA while a hook is active. The stop button can wipe the current program state!

要对此进行测试，请创建一个新模块并将此代码粘贴到其中。然后运行 StartHook。记得在关闭 Excel 或修改代码之前运行 StopAllEventHooks！！在生产代码中，您可能会向 WorkBook_Open 和 WorkBook_BeforeClose 事件添加 StartEventHook 和 StopAllEventHooks，以确保它们在适当的时间运行。请记住，如果在挂钩停止之前 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

Answer 2

回答by Michael

I modified @AndASM 's very nice solution to work in a 64 bit environment. Changes were

我修改了 @AndASM 的非常好的解决方案以在 64 位环境中工作。变化是

changed API function call parameters from Long to LongLong parameters
included PtrSafe attributes
replaced Sheet1.[A1] =with range("a1").value =syntax

将 API 函数调用参数从 Long 更改为 LongLong 参数
包含 PtrSafe 属性
替换Sheet1.[A1] =with range("a1").value =语法

@andasm's code with mods follows

@andasm 的带有 mods 的代码如下

Option Explicit

Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0

Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, _
ByVal eventMax As Long, _
ByVal hmodWinEventProc As LongLong, _
ByVal pfnWinEventProc As LongLong, _
ByVal idProcess As Long, _
ByVal idThread As Long, _
ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare PtrSafe 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()
    Range("a1").Value = "Got Focus"
End Sub

Public Sub Event_LostFocus()
   Range("a1").Value = "Nope"
End Sub

检测（在 VBA 中）包含 excel 实例的窗口何时变为活动状态

提问by Cool Blue

回答by AndASM

Explanation

解释

Example Code

示例代码

回答by Michael

相关推荐

最近更新

标签

检测（在 VBA 中）包含 excel 实例的窗口何时变为活动状态

提问by Cool Blue

回答by AndASM

Explanation

解释

Example Code

示例代码

回答by Michael

相关推荐

vba 数据透视表创建的运行时错误 1004

vba 导航到导航子表单中的不同选项卡

vba 验证用户窗体以检查空控件，使用循环

vba 如何将参数从 Excel 宏传递给批处理文件？

相关推荐

最近更新

标签