在Excel 2019中,我想从文件名中获取人名,比如这样。Summer Lovin' - John Travolta & Olivia Newton-John
或者这个 Eddie Rabbitt sang a duet with Crystal Gayle in 1982
.
我已经动态地创建了一个用户表单,这样我就可以选择有效的名称并将其添加到电子表格的列表中。
然而,我还没有找到一个有效的解决方案来改变用户表单的大小以适应标签和复选框。
你知道我需要做什么吗?我对所有建议持开放态度。
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