从模块构建的表单几秒钟后消失

Question

寻找更可定制的MsgBox。

一些用户向其他用户建议：“即时”构建一个表单。

我正在尝试添加一个表单，它是通过我的 VBA Sub BuildFrmOnTheFly 以编程方式编写的代码。

我的表格显示出来，但突然消失了。
它保持打开状态 10/秒，也许 100/秒。
没有错误。
在 VBE 中，表单存在，如果我从项目浏览器运行它，一切正常。表单保持打开状态，直到我单击“确定”（卸载表单）或从 X 关闭它。
我的系统是 Windows 11 x64、Office 2021 x32。我正在使用 PERSONALS.XLSB，因此我的“自定义 MsgBox”在所有其他 XLSM 文件中均已启用。我出于同样的原因宣布了公共子。

Option Explicit
Public Sub BuildFrmOnTheFly(ByVal strFrmTitle As String, ByVal strFrmTxt As String)

' GestErr.
On Error GoTo GesErr

Dim VBComp As Object
Dim frmZZZ As Object
Dim txtZZZ As MSForms.TextBox
Dim btnZZZ As MSForms.CommandButton
    
    ' If a FORM named frmZZZ exist, delete!
    For Each VBComp In ThisWorkbook.VBProject.VBComponents
        With VBComp
            If .Type = 3 Then
                If .Name = "frmZZZ" Then
                    ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("frmZZZ")
                End If
            End If
        End With
    Next VBComp
    
    ' Save file if isn't.
    If Application.Workbooks("PERSONAL.XLSB").Saved = False Then
        Application.DisplayAlerts = False
        Application.Workbooks("PERSONAL.XLSB").Save
        Application.DisplayAlerts = True
    End If

    ' Hide VBE win.
    Application.VBE.MainWindow.Visible = False

    ' Add and build Form frmZZZ.
    Set frmZZZ = ThisWorkbook.VBProject.VBComponents.Add(3)
    With frmZZZ
        .Properties("BackColor") = RGB(255, 255, 255)
        .Properties("BorderColor") = RGB(64, 64, 64)
        .Properties("Caption") = strFrmTitle
        .Properties("Height") = 150
        .Properties("Name") = "frmZZZ"
        .Properties("ShowModal") = False
        .Properties("Width") = 501
    End With

    ' Build TextBox txtZZZ.
    Set txtZZZ = frmZZZ.Designer.Controls.Add("Forms.TextBox.1")
        With txtZZZ
            .Name = "txtZZZ"
            .BorderStyle = fmBorderStyleNone
            .BorderColor = RGB(169, 169, 169)
            .font.Name = "Calibri"
            .font.Size = 12
            .ForeColor = RGB(70, 70, 70)
            .SpecialEffect = fmSpecialEffectFlat
            .MultiLine = True
            .Left = 0
            .Top = 10
            .Height = 75
            .Width = 490
            .text = strFrmTxt
        End With

    ' Build Button btnZZZ (OK)
    Set btnZZZ = frmZZZ.Designer.Controls.Add("Forms.commandbutton.1")
        With btnZZZ
            .Name = "btnZZZ"
            .Caption = "OK"
            .Accelerator = "M"
            .Top = 90
            .Left = 0
            .Width = 70
            .Height = 20
            .font.Size = 12
            .font.Name = "Calibri"
            .BackStyle = fmBackStyleOpaque
        End With
    
    ' Add module to the Form.
    With frmZZZ.CodeModule
        ' Initialize Form.
        .InsertLines .CountOfLines + 1, "Private Sub UserForm_Initialize()"
        .InsertLines .CountOfLines + 1, "Dim TopOffset As Integer"
        .InsertLines .CountOfLines + 1, "Dim LeftOffset As Integer"
        .InsertLines .CountOfLines + 1, "    TopOffset = (Application.UsableHeight / 2) - (frmZZZ.Height / 2)"
        .InsertLines .CountOfLines + 1, "    LeftOffset = (Application.UsableWidth / 2) - (frmZZZ.Width / 2)"
        .InsertLines .CountOfLines + 1, "    frmZZZ.Top = Application.Top + TopOffset"
        .InsertLines .CountOfLines + 1, "    frmZZZ.Left = Application.Left + LeftOffset"
        .InsertLines .CountOfLines + 1, "    txtZZZ.WordWrap = True"
        .InsertLines .CountOfLines + 1, "    txtZZZ.MultiLine = True"
        .InsertLines .CountOfLines + 1, "    txtZZZ.font.Size = 12"
        .InsertLines .CountOfLines + 1, "    txtZZZ.Left = (frmZZZ.InsideWidth - txtZZZ.Width) / 2"
        .InsertLines .CountOfLines + 1, "    btnZZZ.Left = (frmZZZ.InsideWidth - btnZZZ.Width) / 2"
        .InsertLines .CountOfLines + 1, "End Sub"

        ' Terminate Form.
        .InsertLines .CountOfLines + 1, "Private Sub UserForm_Terminate()"
        ' Remove Form from VBA Proj.
        .InsertLines .CountOfLines + 1, "    ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(""frmZZZ"")"
        .InsertLines .CountOfLines + 1, "    Application.VBE.MainWindow.Visible = True"
        .InsertLines .CountOfLines + 1, "End Sub"

        ' Btn OK close Form.
        .InsertLines .CountOfLines + 1, "Private Sub btnZZZ_Click()"
        .InsertLines .CountOfLines + 1, "   Unload Me"
        .InsertLines .CountOfLines + 1, "End Sub"
    
    End With
    
    ' Add Form frmZZZ and show it.
    Set frmZZZ = VBA.UserForms.Add("frmZZZ")
    frmZZZ.Show
    
' Exit sub, before empty vars.
Uscita: strFrmTitle = Empty
        strFrmTxt = Empty
        Set btnZZZ = Nothing
        Set txtZZZ = Nothing
        Set frmZZZ = Nothing
        Exit Sub
' If error comes.
GesErr: MsgBox "Error in Sub" & vbCrLf & "'BuildFrmOnTheFly'" & vbCrLf & vbCrLf & Err.Description
        Resume Uscita
' End.
End Sub

我怎么称呼它：

Option Explicit
Sub TryBuildFrmOnTheFly()
Dim strText As String
    strText = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut MQ" '95 chars
    Call BuildFrmOnTheFly("This is the form title", strText)
End Sub

问题似乎出在我开始填充时

With frZZZ.CodeModule
....
End With

像 btnZZZ 这样的简单按钮已经给我带来了问题。

        .InsertLines .CountOfLines + 1, "Private Sub btnZZZ_Click()"
        .InsertLines .CountOfLines + 1, "   Unload Me"
        .InsertLines .CountOfLines + 1, "End Sub"

我读过诸如this或this之类的帖子。

Answer 1

显示后添加参数VBModal

frmZZZ.显示vbModal