В 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