简体   繁体   English

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

[英]How to dynamically resize an Excel userform in VBA

In Excel 2019, I want to get people's names from filenames such as this: Summer Lovin' - John Travolta & Olivia Newton-John or this: Eddie Rabbitt sang a duet with Crystal Gayle in 1982 .在 Excel 2019 中,我想从以下文件名中获取人们的姓名: Summer Lovin' - John Travolta & Olivia Newton-John或此: Eddie Rabbitt sang a duet with Crystal Gayle in 1982

I have created a userform dynamically so I can select the valid names and add them to a list on a spreadsheet.我已经动态创建了一个用户表单,因此我可以 select 有效名称并将它们添加到电子表格的列表中。

用户表单示例

However, I have not found a working solution to change the size of the userform to fit the label and checkboxes.但是,我还没有找到一个可行的解决方案来更改用户窗体的大小以适应 label 和复选框。

Any idea of what I need to do?知道我需要做什么吗? I'm open to all suggestions.我愿意接受所有建议。

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

You have (at least) two errors in your code, but you don't see them as you unfortunately hide them with the evil On Error Resume Next statement.您的代码中有(至少)两个错误,但您没有看到它们,因为不幸的是,您使用邪恶的On Error Resume Next语句隐藏了它们。

(1) To access the controls of the form at design time, you need to access them via the Designer -object: (1)要在设计时访问表单的控件,需要通过Designer对象来访问:

For Each c In MyUserForm.Designer.Controls

(2) To set the Width and Height of the form, use .Properties : (2) 要设置表单的宽度和高度,请使用.Properties

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM