如何在 VBA 中动态调整 Excel 用户窗体的大小

Question

在 Excel 2019 中，我想从以下文件名中获取人们的姓名： Summer Lovin' - John Travolta & Olivia Newton-John或此： Eddie Rabbitt sang a duet with Crystal Gayle in 1982 。

我已经动态创建了一个用户表单，因此我可以 select 有效名称并将它们添加到电子表格的列表中。

但是，我还没有找到一个可行的解决方案来更改用户窗体的大小以适应 label 和复选框。

知道我需要做什么吗？ 我愿意接受所有建议。

Option Explicit
Sub SplitstrFNForNames()

    Dim strFN, substr, substr1, substr2 As String
    Dim i, n                            As Integer
    Dim MyUserForm                      As VBComponent
    Dim chkBox                          As MSForms.CheckBox
    Dim Label1                          As MSForms.Label

    ThisWorkbook.Save

    If Cells(ActiveCell.Row, "B") = "" Then
        strFN = "Summer Lovin' – John Travolta & Olivia Newton-John"
    Else
        strFN = Cells(ActiveCell.Row, "B")
    End If

'    Check whether the userform form exists
    For n = 1 To ActiveWorkbook.VBProject.VBComponents.Count
        If ActiveWorkbook.VBProject.VBComponents(n).Name = "MsgboxFNSplit" Then
            ShowMsgbox
            Exit Sub
        Else
        End If
    Next n

'    Make a userform
    Set MyUserForm = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
    With MyUserForm
        On Error Resume Next
        .Name = "MsgboxFNSplit"
        .Properties("Caption") = "Get performers names from filename"
    End With

    Set Label1 = MyUserForm.Designer.Controls.Add("Forms.label.1", "Label_1", True)
    With Label1
        .Caption = "Check names to be added to performers list"
        .Left = 5
        .Top = 5
        .Width = 144
    End With

'    Add checkboxes to userform
    i = 1

    Do
        substr1 = Left(strFN, InStr(1, strFN, " ") - 1)
        strFN = Replace(strFN, substr1 & " ", "")

        If InStr(1, strFN, " ") = 0 Then
            substr2 = strFN
        Else
            substr2 = Left(strFN, InStr(1, strFN, " ") - 1)
        End If

        substr = substr1 & " " & substr2

        Set chkBox = MyUserForm.Designer.Controls.Add("Forms.CheckBox.1", "CheckBox_" & i, True)
        chkBox.Caption = substr
        chkBox.Left = 5
        chkBox.Top = Label1.Height + 5 + ((i - 1) * 20)
        i = i + 1

    Loop Until InStr(1, strFN, " ") = 0

    ' Calculate height & width of userform based on sizes of labels and checkboxes
    Dim h, w
    Dim c As Control

    h = 0: w = 0
    For Each c In MyUserForm.Controls
        If c.Visible Then
            If c.Top + c.Height > h Then h = c.Top + c.Height
            If c.Left + c.Width > w Then w = c.Left + c.Width
        End If
    Next c

    If h > 0 And w > 0 Then ' <<< This is not working
        With MyUserForm
            .Width = w + 40
            .Height = h + 40
        End With
    End If

    ShowMsgbox

'   Remove userform
    With ActiveWorkbook.VBProject
        .VBComponents.Remove .VBComponents("MsgboxFNSplit")
    End With

End Sub

Sub ShowMsgbox()
    MsgboxFNSplit.Show
End Sub

Answer 1

您的代码中有（至少）两个错误，但您没有看到它们，因为不幸的是，您使用邪恶的On Error Resume Next语句隐藏了它们。

（1）要在设计时访问表单的控件，需要通过Designer对象来访问：

For Each c In MyUserForm.Designer.Controls

(2) 要设置表单的宽度和高度，请使用.Properties ：

    With MyUserForm
        .Properties("Width") = w + 40
        .Properties("Height") = h + 40
    End With