如何在 VBA 中动态调整 Excel 用户表单的大小

How to dynamically resize an Excel userform in VBA

在 Excel 2019 年,我想从文件名中获取人名,例如:Summer Lovin' - John Travolta & Olivia Newton-John 或:Eddie Rabbitt sang a duet with Crystal Gayle in 1982.

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

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

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

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

你的代码中有(至少)两个错误,但你没有看到它们,因为你不幸地用邪恶的 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