建立窗体文件求助

CNS1993

建立窗体文件求助，需求见附件，谢谢！ 建立窗体并运行.rar (9.52 KB, 下载次数: 15)

2024-5-21 13:12 上传

点击文件名下载附件

MaterSeCret

Sub 建立窗体文件并运行() Dim TpForm As Object Application.VBE.MainWindow.Visible = False '防止窗口闪动 Set TpForm = ThisWorkbook.VBProject.VBComponents.Add(3) '建立窗体 With TpForm .Properties("Caption") = "新窗体" .Properties("Width") = 300 .Properties("Height") = 200 .Properties("Name") = "窗体文件" End With With TpForm.CodeModule '为窗体添加代码 .DeleteLines 1, .CountOfLines '以下双引号中的代码即为Initialize关联事件代码 .InsertLines 1, "Private Sub UserForm_Initialize()" .InsertLines 2, "Dim frm As Object" .InsertLines 3, "On Error Resume Next" .InsertLines 4, "Set frm = VBA.UserForms(""窗体文件"")" .InsertLines 5, "On Error GoTo 0" .InsertLines 6, "If Not frm Is Nothing Then" .InsertLines 7, "MsgBox ""我是原来的窗体哟""" .InsertLines 8, "Else" .InsertLines 9, "MsgBox ""我是新建的窗体""" .InsertLines 10, "End If" .InsertLines 11, "End Sub" End With VBA.UserForms.Add(TpForm.Name).Show '显示窗体 End Sub

MaterSeCret

Sub 建立窗体文件并运行() Dim TpForm As Object Application.VBE.MainWindow.Visible = False '防止窗口闪动 Set TpForm = ThisWorkbook.VBProject.VBComponents.Add(3) '建立窗体 With TpForm .Properties("Caption") = "新窗体" .Properties("Width") = 300 .Properties("Height") = 200 .Properties("Name") = "窗体文件" End With With TpForm.CodeModule '为窗体添加代码 .DeleteLines 1, .CountOfLines '以下双引号中的代码即为Initialize关联事件代码 .InsertLines 1, "Private Sub UserForm_Initialize()" .InsertLines 2, "Dim frm As Object" .InsertLines 3, "On Error Resume Next" .InsertLines 4, "Set frm = VBA.UserForms(""窗体文件"")" .InsertLines 5, "On Error GoTo 0" .InsertLines 6, "If Not frm Is Nothing Then" .InsertLines 7, "MsgBox ""我是原来的窗体哟""" .InsertLines 8, "Else" .InsertLines 9, "MsgBox ""我是新建的窗体""" .InsertLines 10, "End If" .InsertLines 11, "End Sub" End With VBA.UserForms.Add(TpForm.Name).Show '显示窗体 End Sub

MaterSeCret

Sub 建立窗体文件并运行()
Dim TpForm As Object
Application.VBE.MainWindow.Visible = False '防止窗口闪动
Set TpForm = ThisWorkbook.VBProject.VBComponents.Add(3) '建立窗体
With TpForm
.Properties("Caption") = "新窗体"
.Properties("Width") = 300
.Properties("Height") = 200
.Properties("Name") = "窗体文件"
End With
With TpForm.CodeModule '为窗体添加代码
.DeleteLines 1, .CountOfLines '以下双引号中的代码即为Initialize关联事件代码
.InsertLines 1, "Private Sub UserForm_Initialize()"
.InsertLines 2, "Dim frm As Object"
.InsertLines 3, "On Error Resume Next"
.InsertLines 4, "Set frm = VBA.UserForms(""窗体文件"")"
.InsertLines 5, "On Error GoTo 0"
.InsertLines 6, "If Not frm Is Nothing Then"
.InsertLines 7, "MsgBox ""我是原来的窗体哟"""
.InsertLines 8, "Else"
.InsertLines 9, "MsgBox ""我是新建的窗体"""
.InsertLines 10, "End If"
.InsertLines 11, "End Sub"
End With
VBA.UserForms.Add(TpForm.Name).Show '显示窗体
End Sub

MaterSeCret

试试行不行

MaterSeCret

我回复了好多次，为啥没显示

MaterSeCret

请保留5楼的试一试，其他请删掉

CNS1993

MaterSeCret 发表于 2024-5-21 14:01
试试行不行

谢谢。但第二次运行，就出现问题了。

蓝桥玄霜

窗体的例子：

CNS1993

蓝桥玄霜 发表于 2024-5-21 14:38
窗体的例子：

蓝桥玄霜老师，太牛了。谢谢您，辛苦了！！
Sub CheckAndAddUserForm()
    Dim frm As Object
    Dim frmFound As Boolean
    '初始化标志为假
    frmFound = False
    '遍历活动工作簿所有VB组件，查找用户窗体
    For Each frm In ThisWorkbook.VBProject.VBComponents
        If frm.Type = 3 And frm.Name = "我的窗体" Then
            frmFound = True
            With frm.CodeModule '为窗体添加代码
                .DeleteLines 1, .CountOfLines '以下双引号中的代码即为Initialize关联事件代码
                .InsertLines 1, "Private Sub UserForm_Initialize ()"
                .InsertLines 2, "MsgBox ""我是原来的窗体哟"""
                .InsertLines 3, "End Sub"
            End With
            Exit For
        End If
    Next frm
    '根据查找结果进行相应
    If frmFound Then
        MsgBox "已存在窗体", vbInformation
    Else
        Set frm = ThisWorkbook.VBProject.VBComponents.Add(3)
        With frm
            .Properties("Caption") = "智能输入"
            .Properties("Width") = 200
            .Properties("Height") = 300
            .Properties("Name") = "我的窗体"
        End With
        With frm.CodeModule '为窗体添加代码
            .DeleteLines 1, .CountOfLines '以下双引号中的代码即为Initialize关联事件代码
            .InsertLines 1, "Private Sub UserForm_Initialize ()"
            .InsertLines 2, "MsgBox  ""我是新建的窗体"""
            .InsertLines 3, "End Sub"
        End With
    End If
    VBA.UserForms.Add(frm.Name).Show '显示窗体
End Sub