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

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.

Nutter

You can use an Application level Event to do this. See Pearson. Using WorkbookActivate will flag when any workbook in that instance is activated. If you use this code in an addin it will work in any instance (but also it will flag when you tab between workbooks within that instance). – Hue

And also what should happen if an empty excel application gets activated? i.e there are no workbooks opened? What exactly are you trying to achieve? – Crossman

@Hue OK, thanks. I had already tried the WorkbookActivate event in ThisWorkBook and I thought that would be the same as the Application level version you suggest. I just tried your suggestion but got the same result: the Application WorkbookActivate event didn't fire either. I put it in a Class Module and verified that other Application events were working OK, so looks like it doesn't do what I want. – Nutter

@Siddharth Rout Good question; I will edit the question to provide the extra information you requested... – Nutter

None of the events Workbook_Activate(), Workbook_WindowResize(ByVal Wn As Window), Workbook_WindowActivate(ByVal Wn As Window) will fire when the workbook(Excel Application actually) is brought into focus say by minimizing a browser, because the workbook is not getting activated. It is already active. The application is getting activated and unfortunately, the Application itself per se does not have an Application_Activate event. What you want can be achieved using vb.net/vb6 though. – Crossman

is brought into focus say by minimizing a browser, because the workbook is not getting activated. true, although the question did state click. – Hue

@CoolBlue Did you initialise the event - it certainly works when you click on Excel. Sid's point re focus holds though. – Hue

Here is another way which might get you somewhere. This process is called Hooking See THIS – Crossman

More about Hooks HERE Be careful. One wrong line of code and Excel will crash :) – Crossman

@Hue no, Click is fine actually... I'll be happy if it fires on mouse click but, not firing. The same application object is throwing other events though, which I dropped in just to check. I better take a closer look. And yes its initialised for sure. – Nutter

OK, thanks @Siddharth Rout I'm always up for a bit of adventure...! – Nutter

@SiddharthRout you'll be pleased to know that I found a more robust approach in my code that eliminates the need for managing the window. Im sure you would aprove that principle :) I'll still have a look at those hooks though when I get time. – Nutter

@CoolBlue: Go ahead ;) Post it as an answer :) – Crossman

@SiddharthRout The hooks you mean? Yes, when I have time I will definitely do that to close out the thread. – Nutter

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

Inconsiderate

Suggesting a small change in Public Sub StopAllEventHooks() ... lHook = CLng(vHook) – Lifton

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

Schoolteacher

Answer 3

I'm using this to activate a Modeless userform textbox after switching between windows.

Code from @AndASM and Michael version, with some mods (StopAllEventHooks now working, tested in Excel 32 and 64)

This is a standard module (named "Hooking" for example):

Option Explicit

'https://mcmap.net/q/590464/-detecting-in-vba-when-the-window-containing-an-excel-instance-becomes-active
'https://mcmap.net/q/591254/-detecting-lost-focus-in-excel-application-workbook-or-worksheet
'https://social.msdn.microsoft.com/Forums/office/en-US/70ec18cd-2438-4c96-bbb0-97cdecd3ddbb/detect-the-event-when-someone-minimizes-or-maxmize-the-excel-application?forum=exceldev
'https://learn.microsoft.com/es-es/windows/win32/winmsg/using-hooks?redirectedfrom=MSDN
'https://mcmap.net/q/591255/-call-event-in-excel-vba-when-switching-to-another-app
'https://mcmap.net/q/591256/-forms-gotfocus-event-does-not-seem-to-fire/4659751#4659751

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

#If VBA7 Then
    Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal lpfnWinEventProc 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
    'https://mcmap.net/q/591257/-vba-codes-32bit-to-64bit
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
    Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As LongPtr) As Long
#Else
    'https://www.vbforums.com/showthread.php?861147-RESOLVED-help-How-to-use-SetWinEventHook-to-determine-an-application-s-window-is-created
    Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc 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 Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    'https://mcmap.net/q/591258/-unhookwinevent-does-not-unhook-in-vba
    Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
#End If

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
#If VBA7 Then
   Public Sub StopEventHook(lHook As LongPtr)
#Else
    Public Sub StopEventHook(lHook As Long)
#End If
  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
#If VBA7 Then
    Dim lHook As LongPtr
#Else
    Dim lHook As Long
#End If
For Each vHook In pRunningHandles
    #If VBA7 Then
        lHook = CLngPtr(vHook)
    #Else
        lHook = CLng(vHook)
    #End If
    StopEventHook lHook
Next vHook
End Sub
#If VBA7 Then
    Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
                            ByVal hWnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
                            ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
#Else
    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
#End If
  '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()
'Debug.Print "GOT FOCUS"
Activar_userform_visible
'Dim SoundName As String
'SoundName = "C:\WINDOWS\Media\Chimes.wav"
'PlayWavSound SoundName, 1
End Sub
Public Sub Event_LostFocus()
'Debug.Print "Nope"
'Dim SoundName As String
'SoundName = "C:\WINDOWS\Media\recycle.wav" 'Chimes.wav
'PlayWavSound SoundName, 1
End Sub

Create a userform ("UserForm1") with 2 textboxes. This is the UserForm1 code module:

Option Explicit
#If VBA7 Then
    Dim MeHWnd As LongPtr, lngCurrentStyle As Long, lngNewStyle As Long
#Else
    Dim MeHWnd As Long, lngCurrentStyle As Long, lngNewStyle As Long
#End If

'http://www.cpearson.com/excel/SuppressChangeInForms.htm
'https://riptutorial.com/vba/example/19036/best-practices
Private Type TView
    IsCancelled As Boolean
    EnableEvents As Boolean
End Type
Private this As TView
Public Property Get IsCancelled() As Boolean
    IsCancelled = this.IsCancelled
End Property
Public Property Get EnableEvents() As Boolean
    EnableEvents = this.EnableEvents
End Property
Private Sub UserForm_Initialize()
On Error GoTo ExceptionHandling
'If Application.Version < 9 Then
'    MeHWnd = FindWindow("THUNDERXFRAME", Me.Caption) 'XL97
'Else
    MeHWnd = FindWindow("THUNDERDFRAME", Me.Caption) 'XL2000+
'End If

lngCurrentStyle = GetWindowLong(MeHWnd, GWL_STYLE)
lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
SetWindowLong MeHWnd, GWL_STYLE, lngNewStyle

this.EnableEvents = True

CleanUp:
    On Error Resume Next
    Exit Sub
ExceptionHandling:
    'MsgBox "Error: " & Err.Description
    Resume CleanUp
    'https://mcmap.net/q/591262/-excel-vba-global-variables-are-assigned-when-workbook-is-opened-get-erased-if-an-error-occurs
    Resume 'for debugging
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = VbQueryClose.vbFormControlMenu Then
        Cancel = True
        this.IsCancelled = True
        'ListBox1.Clear
        'ListBox3.Clear
        StopAllEventHooks
        Me.Hide
    End If
End Sub
Private Sub UserForm_Layout()
'https://www.mrexcel.com/board/threads/how-can-i-tell-if-a-userform-has-been-minimized-vba.920923/
'https://mcmap.net/q/591259/-unhook-scroll-when-userform-minimized
If IsIconic(MeHWnd) Then
    'MsgBox "The userform : '" & Me.Name & "' has just been minimized", vbInformation
    StopAllEventHooks
ElseIf IsZoomed(MeHWnd) Then
    'MsgBox "The userform : '" & Me.Name & "' has just been maximized", vbInformation
    Activar_userform_visible
    StartHook
Else
    'MsgBox "The userform : '" & Me.Name & "' has just been restored", vbInformation
    Activar_userform_visible
    StartHook
End If
End Sub

Code placed in another standard module ("Module1" for example):

#If VBA7 Then
    Public Declare PtrSafe Function PlayWavSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
    Public Declare PtrSafe Function IsZoomed Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Public Declare Function PlayWavSound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal LpszSoundName As String, ByVal uFlags As Long) As Long
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
    Public Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long
#End If

'Siddharth Rout: https://mcmap.net/q/591260/-minimize-userform-when-macro-in-it-is-running/20558520#20558520
'https://answers.microsoft.com/en-us/msoffice/forum/all/excel-vba-how-to-exclude-minimize-and-esc-button/0617ee7c-6c49-4127-8dba-3f8eb04acb9d
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_MAXIMIZEBOX As Long = &H10000

Public Const GWL_STYLE As Long = -16

Sub Show_Userform1()
Dim frm As UserForm1
Set frm = New UserForm1
frm.Show vbModeless
End Sub

Sub Activar_userform_visible()
Dim objLoop As Object, Pausa As Single, Inicio As Single
Pausa = 0.2
For Each objLoop In VBA.UserForms
    If (objLoop.Name = "UserForm1" Or objLoop.Name = "UserForm1") And objLoop.Visible = True Then
        'https://mcmap.net/q/591261/-set-focus-back-to-the-application-window-after-showing-userform
        AppActivate objLoop.Caption
        Inicio = Timer
        Do While Timer < Inicio + Pausa
          DoEvents
        Loop
        CreateObject("WScript.Shell").SendKeys "{TAB}", True
        CreateObject("WScript.Shell").SendKeys "+{TAB}", True
    End If
Next objLoop
End Sub

Lifton