当包含excel实例的窗口变为活动状态时检测（在VBA中） [英] Detecting (in VBA) when the window containing an excel instance becomes active

问题描述

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

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

我也可以通过SendKeys来做这件事，但它不好，因为它擦除了键盘设置（例如滚动锁）由于SendKeys中记录的错误，它使屏幕闪烁超过我想要的。

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

解决方案

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

说明

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

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

示例代码

要测试这个，创建一个新的模块并将其粘贴到该模块中。然后运行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 
 
私有声明函数SetWinEventHook Libuser32.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 
私有声明函数GetCurrentProcessId Libkernel32（）As Long 
私有声明函数GetWindowThreadProcessId Lib user32（ByVal hWnd As Long，lpdwProcessId As Long）As Long 
 
私人pRunningHandles作为集合
 
公共功能StartEventHook（）As Long 
如果pRunningHandles不是然后设置pRunningHandles =新集合
 StartEventHook = SetWinEventHook（EVENT_SYSTEM_FOREGROUND，EVENT_SYSTEM_FOREGROUND，0& AddressOf WinEventFunc，0，0，WINEVENT_OUTOFCONTEXT）
 pRunningHandles.Add StartEventHook 
结束函数
 
 Public Sub StopEventHook（1Hook As Long）
 Dim LRet As Long 
 If （1）
 
公开Sub StartHook（）
 StartEventHook 
 End Sub 
 
公共Sub StopAllEventHooks（）
 Dim vHook As Variant，1Hook As Long 
对于每个vHook在pRunningHandles 
 1Hook = vHook 
 StopEventHook 1Hook 
下一步vHook 
 End Sub 
 
公共函数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 
'此函数是传递给win32的回调api 
'我们不能抛出错误或中断。坏事情会发生。 
 On Error Resume Next 
 Dim thePID As Long 
 
如果LEvent = EVENT_SYSTEM_FOREGROUND然后
 GetWindowThreadProcessId hWnd，thePID 
如果PID = GetCurrentProcessId然后
 Application.OnTime现在，Event_GotFocus
 Else 
 Application.OnTime现在，Event_LostFocus
 End If 
 End If 
 
 On Error GoTo 0 
结束函数
 
 Public Sub Event_GotFocus（）
 Sheet1。[A1] =Got Focus
 End Sub 
 
 Public Sub Event_LostFocus ）
 Sheet1。[A1] =Nope
 End Sub 
  

I can see the WindowActivate events 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?

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.

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

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 WorkbookActivate event to refresh the application if and when the user selects the workbook containing it.

解决方案

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

Explanation

You can use the win32 api function SetWinEventHook to 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.

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.

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.

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 not press the stop button in VBA while a hook is active. The stop button can wipe the current program state!

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

这篇关于当包含excel实例的窗口变为活动状态时检测（在VBA中）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！