UserForm onActivate does not fire

[S.Br.]

Dear Mr.Excel;
tell me please how to catch the UserForm.onActive event in my VBA code.
The article "Activate, Deactivate events" clearly says: "The Activate and Deactivate events occur only when you move the focus ...", but my Sub UserForm_Activate() does not get called when I move focus from worksheet to my UserForm. Steps to reproduce this glitch are as simple as this:
A. create a new workbook;
B. add a UserForm; and add

Private Sub UserForm_Activate()
MsgBx "UserForm_Activate"
End Sub

C. show the form modelessly; the "UserForm_Activate" message does pop-up.
D. switch focus between the form and worksheet, then back to the form - the event no longer fires, why?
The Excel version tested: 10, 12, 14, 16.
Many thanks in advance.

 

[Micron]

Try the form click event if you want something to happen every time a user clicks on it - although I can't imagine wanting to do that.

 

[Jaafar Tribak]

That MS definition is misleading. The UserForm Activate and Deactivate events fire only when the focus shifts between userforms . In other words, the Activate event will fire when first shown but won't fire when gaining focus from the application or from any object other than another userform.

You can use the following hacky workaround :

Place in the UserForm Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As LongPtr) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private hwnd As LongPtr
#Else
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUF As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private hwnd As Long
#End If

Private WithEvents cmbrsEvents As CommandBars
Private bToggle As Boolean

Private Sub UserForm_Initialize()
    Call IUnknown_GetWindow(Me, VarPtr(hwnd))
    Set cmbrsEvents = Application.CommandBars
    Call cmbrsEvents_OnUpdate
End Sub

Private Sub cmbrsEvents_OnUpdate()
    If GetActiveWindow = hwnd Then
        If bToggle = False Then
            bToggle = True
            Call UserForm_Fake_Activate
        End If
    Else
        If bToggle Then
            bToggle = False
            Call UserForm_Fake_Deactivate
        End If
    End If
    With Application
        .DisplayFullScreen = .DisplayFullScreen
    End With
End Sub

' ____________________________________ PSEUDO EVENTS _______________________________________

Private Sub UserForm_Fake_Activate()
    MsgBox "UserForm Activated"
End Sub

Private Sub UserForm_Fake_Deactivate()
    MsgBox "UserForm Deactivated"
End Sub

 

[S.Br.]

Thanks for the your thoughts, Jaafar. And yet, I have to disagree with you saying:

The UserForm Activate and Deactivate events fire only when the focus shifts between userforms.

The event does fire when focus is shifted from worksheet window to userform, but not always: to reproduce, have 2 modeless userforms shown and switch focus from one form to another, then to the worksheet, and then to the 1st form: the Activate event of the 1st form does get triggered. It is just another glitch of MS handling its own WM_ACTIVATE message by UserForm window.
As for your code handling the userform windows activation, I can't use it because it relies on Application.CommandBars which I do not have, thanks for the sample.
I guess I'll go with an old brute force approach of subclassing.

 

[Dan_W]

Thanks for the your thoughts, Jaafar. And yet, I have to disagree with you saying:

The event does fire when focus is shifted from worksheet window to userform, but not always: to reproduce, have 2 modeless userforms shown and switch focus from one form to another, then to the worksheet, and then to the 1st form: the Activate event of the 1st form does get triggered. It is just another glitch of MS handling its own WM_ACTIVATE message by UserForm window.
As for your code handling the userform windows activation, I can't use it because it relies on Application.CommandBars which I do not have, thanks for the sample.
I guess I'll go with an old brute force approach of subclassing.

Why do you not have Application.CommandBars? I thought this was for use in Excel.

 

[Micron]

Still have to wonder why the activate event when clicking from sheet to form and not the click event.

 

[Jaafar Tribak]

As for your code handling the userform windows activation, I can't use it because it relies on Application.CommandBars which I do not have, thanks for the sample.

As Dan_W pointed out, Application.CommandBars is available in all office applications so I don't see why you don't have it !

to reproduce, have 2 modeless userforms shown and switch focus from one form to another, then to the worksheet, and then to the 1st form: the Activate event of the 1st form does get triggered

You still need to switch focus to another userform

I guess I'll go with an old brute force approach of subclassing.

Subclassing won't work with modeless userfoms. It will immediatly crash the entire excel application ... Modal userfoms (which you are not using here) can be subclassed but still you need to set up very robust error handling,

Anyways, in case you want to proceed, I would recommend using a windows timer attached to the userform hwnd and released upon closing the form.

Still have to wonder why the activate event when clicking from sheet to form and not the click event.

That won't fire when activating the form(s) via the titlebar so the *activate* event won't be consistent.

 

[S.Br.]

Why do you not have Application.CommandBars? I thought this was for use in Excel.

In this particular project the CommandBars are removed (hidden+disabled); it's a kind of presentation where all you can see is a full screen view of worksheet with just data in plots, graphs and userforms (even column/row headers and worksheet tabs are hidden to maximize the view area).

 

[Jaafar Tribak]

In this particular project the CommandBars are removed (hidden+disabled); it's a kind of presentation where all you can see is a full screen view of worksheet with just data in plots, graphs and userforms (even column/row headers and worksheet tabs are hidden to maximize the view area).

I see. That is an unusual situation I coud never have anticipated

Well, in that case, the only thing I can think of is to use a windows timer workaround because both, subclassing and hooking applied to modeless userforms, won't work for catching the wm_activate event.

I wrote this vba project which uses a win32 timer to monitor the activation\deactivation of all the loaded userforms. The good thing about this code is that it works on as many forms as you like and it catches both the activate and decativate events in chronological order ... Both activate and deactivate will fire when switching between the userforms as well as when switching between userforms and worksheet or any other UI object belonging within the current excel session.

The project design is Class-based in keeping with the OOP theme for easy use.


File Demo:
UserFormsActivateDeactivateEvents.xlsm


Watch the output in the immediate window as I switch between the various forms and\or between the forms and worksheet.




1- Class Module ( CFormEvents )

Option Explicit

Event Activate(ByVal UserForm As MSForms.UserForm)
Event Deactivate(ByVal UserForm As MSForms.UserForm)

Public Sub Init(ByVal UserForm As Object)
    Call StartEventsWatch
    Call Wait(0.1)
End Sub

Public Sub RaiseEvents(ByVal UserForm As MSForms.UserForm, ByVal EventType As EVENTS)
    If EventType = ActivateEvent Then
        RaiseEvent Activate(UserForm)
    Else
        RaiseEvent Deactivate(UserForm)
    End If
End Sub

Private Sub Wait(ByVal Howlong As Single)
    Dim t As Single
    t = Timer: Do: DoEvents: Loop Until Timer - t >= Howlong
End Sub

2- Worker API code in a BAS Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Public Enum EVENTS
    ActivateEvent
    DeactivateEvent
End Enum

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0& To 7&) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As LongPtr
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As LongPtr
    Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
#End If


Public Sub StartEventsWatch()
    Call KillTimer(Application.hwnd, NULL_PTR)
    Call SetTimer(Application.hwnd, NULL_PTR, 0&, AddressOf WatchProc)
End Sub


' _______________________________ PRIVATE HELPER ROUTINES _______________________________

Private Sub StopTimer()
    Call KillTimer(Application.hwnd, NULL_PTR)
    Debug.Print "timer safely released."
End Sub
 
Private Sub WatchProc()
    Static oPrevForm As Object
    Dim oCurForm As Object
    Dim lPid As Long
      
    If VBA.UserForms.Count = 0& Then
        Call StopTimer:  Exit Sub
    End If
    Call GetWindowThreadProcessId(GetActiveWindow, lPid)
    If GetCurrentProcessId <> lPid Then
        Exit Sub
    End If
    On Error Resume Next
        Set oCurForm = HwndToDispatch(GetActiveWindow)
        If Not (oPrevForm Is oCurForm) Then
            Call oPrevForm.UserForms.RaiseEvents(oPrevForm, DeactivateEvent)
            Call oCurForm.UserForms.RaiseEvents(oCurForm, ActivateEvent)
        End If
    On Error GoTo 0
    Set oPrevForm = oCurForm
  
End Sub

Private Function HwndToDispatch(ByVal hwnd As LongPtr) As Object
    Const WM_GETOBJECT = &H3D&, OBJID_CLIENT = &HFFFFFFFC
    Const GW_CHILD = 5&, S_OK = 0&
    Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Dim uGUID As GUID, oDisp As Object
    Dim hClient As LongPtr, lResult As Long
  
    hClient = GetNextWindow(hwnd, GW_CHILD)
    lResult = SendMessage(hClient, WM_GETOBJECT, NULL_PTR, ByVal OBJID_CLIENT)
    If lResult Then
        If IIDFromString(StrPtr(IID_IDISPATCH), uGUID) = S_OK Then
            If ObjectFromLresult(lResult, uGUID, NULL_PTR, oDisp) = S_OK Then
                If Not oDisp Is Nothing Then
                    Set HwndToDispatch = oDisp
                End If
            End If
        End If
    End If
End Function

3- Code Usage in the UserForm(s) Module(s)

Option Explicit

Public WithEvents UserForms  As CFormEvents

Private Sub UserForm_Initialize()
    Set UserForms = New CFormEvents
    UserForms.Init Me
End Sub

' ___________________________ PSEUDO EVENTS __________________________________

Private Sub UserForms_Activate(ByVal UserForm As MSForms.UserForm)
    If UserForm Is Me Then
        Debug.Print Me.Name & " " & String(6&, "-") & " Activated"
    End If
End Sub

Private Sub UserForms_Deactivate(ByVal UserForm As MSForms.UserForm)
    If UserForm Is Me Then
        Debug.Print Me.Name & " " & String(14&, "-") & " Deactivated"
    End If
End Sub