解释

Question

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

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

我也可以通过SendKeys做到这一点，但它并不好，因为它消除了键盘设置（例如滚动锁定），因为SendKeys中存在记录的错误，它使屏幕闪烁得比我想要的更多。

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

Answer 1

我认为这不是直接在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

Answer 2

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

将API函数调用参数从Long更改为LongLong参数
包含PtrSafe属性
将 Sheet1。[A1] = 替换为范围（“a1”）。value = 语法

@ andasm的mod代码如下

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

Answer 3

以下是如何使用VBA实现这一点：Detecting when Excel loses focus?

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

3 个答案:

解释

示例代码