VBA - 是否可以从使用 API 函数 GetActiveWindow 检索到的句柄中获取用户窗体对象？

Question

一切都在标题中... 在 VBA 中，是否可以从使用 API 函数 GetActiveWindow 检索到的句柄中获取用户窗体对象？ 提前感谢任何建议

Answer 1

最终是无模式用户窗体中完全高效的 MsgBox 的 VBA 模块的全局代码：

Option Explicit

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
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
        .Visible = Not .Visible
        .Visible = Not .Visible
        .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(256, Chr(0))
    Call GetWindowText(GetActiveWindow, WindowText, 255)
    WindowText = Left(WindowText, InStr(WindowText, Chr(0)) - 1)
    'MsgBox "<" & WindowText & ">"
    
    'Run through 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

Answer 2

好吧，我想我找到了找到活动用户窗体的方法...

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

Sub Test()
    Dim UserForm As Object

    UserForm1.Show vbModeless
    UserForm2.Show vbModeless
    Set UserForm = GetActiveUserForm
    MsgBox UserForm.Name
End Sub

'------------------------------------------------------------
'Returns the UserForm Object of the currently active UserForm
'------------------------------------------------------------
Public Function GetActiveUserForm() As Object
    Dim UserForm As Object
    Dim WindowText As String

    WindowText = String(255, Chr(0))
    Call GetWindowText(GetActiveWindow, WindowText, 255)
    WindowText = Left(WindowText, InStr(WindowText, Chr(0)) - 1)
    'MsgBox "<" & WindowText & ">"

    'Run through 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