All is in the title... In VBA, is it possible to get the UserForm Object from its Handle retrieved with the API function GetActiveWindow in order to create a MsgBox-like function that works well in a Modeless UserForm ? Thanks in advance for any proposal

2

There are 2 best solutions below

2
Jean-Paul On

OK I think I found a way to find the active UserForm...

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long

'------------------------------------------------------------
'Returns the UserForm Object of the currently active UserForm
'------------------------------------------------------------
Function GetActiveUserForm() As Object
    Dim UserForm As Object
    Dim WindowText As String
    
    WindowText = String(GetWindowTextLength(GetActiveWindow) + 1, Chr$(0))
    Call GetWindowText(GetActiveWindow, WindowText, Len(WindowText))
    WindowText = Left(WindowText, Len(WindowText) - 1)
    'MsgBox "<" & WindowText & ">"
    
    'Run through the visible UserForms of the Projet
    For Each UserForm In VBA.UserForms
        If UserForm.Visible Then
            If UserForm.Caption = WindowText Then Exit For
        End If
    Next UserForm
    
    If Not UserForm Is Nothing Then
        'Return value
        Set GetActiveUserForm = UserForm
    End If
End Function
1
Jean-Paul On

And eventually the global code for a VBA Module of a fully efficient MsgBox in a Modeless UserForm:

Option Explicit

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long

'---------------------------------------------
'MsgBox in a Modeless UserForm
'Same parameters as a regular MsgBox
'Return: Same return value as a regular MsgBox
'---------------------------------------------
Function MsgBoxInModelessUserForm(Prompt As String, _
                                  Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
                                  Optional Title As String = "Microsoft Excel", _
                                  Optional HelpFile As String = "", _
                                  Optional Context As Integer = 0) As VbMsgBoxResult
                          
    Dim UserForm As Object
    Dim Control As Control
    Dim ReturnValue As VbMsgBoxResult
    
    ReturnValue = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
    
    'Get active UserForm
    Set UserForm = GetActiveUserForm
    
    If Not UserForm Is Nothing Then
        Call ForceSetFocusInReactivatedModelessUserForm(UserForm)
    End If
    
    'Return value
    MsgBoxInModelessUserForm = ReturnValue
End Function

'---------------------------------------------------------------
'Force the Focus after the re-activation of a Modeless UserForm
'Can be used when returning from MsgBox or from another UserForm
'---------------------------------------------------------------
Sub ForceSetFocusInReactivatedModelessUserForm(UserForm_Or_Control As Object)
    Dim Control As MSForms.Control
    
    'Get the Control
    If TypeOf UserForm_Or_Control Is UserForm Then
        Set Control = UserForm_Or_Control.ActiveControl
    Else
        Set Control = UserForm_Or_Control
    End If

    With Control
        'Force Control activation
        'Warning !  This will trigger a Control_Exit() + Control_Enter() on the Active Control of the UserForm !
        '           So if coded, use a Public UserForm Flag to ignore these events in the case of Reactivation
        'UserForm.PublicReactivationFlag = True
        .Visible = False    'Triggers a Control_Exit()
        'UserForm.PublicReactivationFlag = True
        .Visible = True     'Triggers a Control_Enter()
        .SetFocus
    End With
End Sub

'------------------------------------------------------------
'Returns the UserForm Object of the currently active UserForm
'------------------------------------------------------------
Function GetActiveUserForm() As Object
    Dim UserForm As Object
    Dim WindowText As String
    
    WindowText = String(GetWindowTextLength(GetActiveWindow) + 1, Chr$(0))
    Call GetWindowText(GetActiveWindow, WindowText, Len(WindowText))
    WindowText = Left(WindowText, Len(WindowText) - 1)
    'MsgBox "<" & WindowText & ">"
    
    'Run through the visible UserForms of the Projet
    For Each UserForm In VBA.UserForms
        If UserForm.Visible Then
            If UserForm.Caption = WindowText Then Exit For
        End If
    Next UserForm
    
    If Not UserForm Is Nothing Then
        'Return value
        Set GetActiveUserForm = UserForm
    End If
End Function