[英]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 有效名稱並將它們添加到電子表格的列表中。
但是,我還沒有找到一個可行的解決方案來更改用戶窗體的大小以適應 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
您的代碼中有(至少)兩個錯誤,但您沒有看到它們,因為不幸的是,您使用邪惡的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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.