Detecting (in VBA) when the window containing an excel instance becomes active - excel

Question

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 it's 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.

Answer 1

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

Answer 2

I modified #AndASM 's very nice solution to work in a 64 bit environment. Changes were
changed API function call parameters from Long to LongLong parameters
included PtrSafe attributes
replaced Sheet1.[A1] = with range("a1").value = syntax
#andasm's code with mods follows
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