VBA Excel表单从模块中构建,几秒钟后消失

ulydmbyx  于 2023-03-20  发布在  其他
关注(0)|答案(1)|浏览(125)

寻找一个更可定制的MsgBox,我读了一些用户,建议别人与我同样的问题:“即时”创建一个表单!这就是我的工作。
我的代码一直在运行,窗体一直在显示,但突然又消失了。
只有几个10/秒,也许100/秒仍然开放。
没有错误。
在VBE形式存在,如果我运行它从项目浏览器,一切都是好的,形式保持打开,直到我点击确定(卸载形式)或关闭它从X。
我不明白为什么。
我得到了Windows 11 x64,Office 2021 x32。我在我的个人工作。XLSB所以我的“自定义MsgBox”是在我所有其他XLSM启用;我声明了一个公共Sub也是出于同样的原因。
下面是我的代码:

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这样的帖子了,但是没什么可做的。等你,比我更Maven,提前谢谢你。

ctrmrzij

ctrmrzij1#

显示后,添加参数VBModal
frmZZZ.显示vbModal

相关问题