所以我有一个工作簿，它使用UserForm在表中创建一个新记录。它还创建了一个新的工作表选项卡，该选项卡使用一些信息来创建这个新选项卡的名称
然而，我想然后超链接到这个新创建的选项卡，但遇到了一个障碍，因为大多数支持页面都需要一个"活动单元格"，而在我运行用户表单之前，我没有这个单元格。
我的步骤是：-
- 用户填写用户表单并单击提交
- 这会做两件事：-A.创建了一个新的选项卡，其中包含课程日期、课程名称和培训师的首字母缩写，例如01102000EXEL1MG，这将是包含表格的该选项卡的唯一名称。B.然后我有一个现有的选项卡，其中包含一个表，在这个表中创建了一个新行，其中包含用户表单中的信息，如课程日期、课程名称、培训师和其他一些详细信息
- 然后，我需要做的是使用新创建的选项卡名称，例如01102000EXEL1MG，并在新创建的行中的"课程列表"表中创建一个指向该选项卡的超链接
这可能吗？
我尝试了以下操作，但没有成功：-
使活动单元格成为新建选项卡的超链接
https://mindovermetal.org/en/how-to-add-and-hyperlink-new-sheets-with-vba-in-excel/
迄今为止尝试的代码：-
Option Explicit
Private Sub CommandButtonCompleteBookerInformation_Click()
'Step 1: Once 'Complete Booker Information' Cmd Button selected, start UserForm Data Validation
'1.1 Course Name not Empty
If TextBoxCourseName.Text = "" Then
MsgBox "Please add a course name", vbCritical
Exit Sub
Else
'1.2 Course Date in XX/XX/XXXX Format
If TextBoxCourseDate.Text = "" Then
MsgBox "Please add the course date in XX/XX/XXXX format", vbCritical
Exit Sub
Else
Dim date_format As String
date_format = "##/##/####"
If Not TextBoxCourseDate.Text Like date_format Then
MsgBox "Please add the course date in XX/XX/XXXX format", vbCritical
Exit Sub
Else
'1.3 Course Duration is numeric
If IsNumeric(TextBoxDurationDays) = False Then
MsgBox "Please enter the course duration in Number of Days (numeric)", vbCritical
Exit Sub
Else
''''''
'Step 2 End Ifs
End If
End If
End If
End If
''''''
'Step 3: Take this information and populate the sheet
'3.1 Get Course Name Info and store in correct cell
Dim CourseNameValue As String
CourseNameValue = TextBoxCourseName.Text
Sheets(Sheets.Count).Range("D3").Value = CourseNameValue
'3.2 Same with Course Date
Dim CourseDateValue As String
CourseDateValue = TextBoxCourseDate.Text
Sheets(Sheets.Count).Range("D4").Value = CourseDateValue
'3.3 Same with Course Duration
Dim CourseDurationValue As String
CourseDurationValue = TextBoxDurationDays.Text
Sheets(Sheets.Count).Range("D9").Value = CourseDurationValue
'3.4 Get Trainer Name and store in correct cell
If OptionTrainerNameAB.Value = True Then
Sheets(Sheets.Count).Range("D6").Value = "name 1 part a"
Sheets(Sheets.Count).Range("G6").Value = "name 1 part b"
Else
If OptionTrainerNameCD.Value = True Then
Sheets(Sheets.Count).Range("D6").Value = "name 2 part a"
Sheets(Sheets.Count).Range("G6").Value = "name 2 part b"
Else
If TextBoxTrainerNameOther.Text <> "" Then
Sheets(Sheets.Count).Range("D6").Value = TextBoxTrainerNameOther.Text
Else
Sheets(Sheets.Count).Range("D6").Value = "Unknown"
End If
End If
End If
'3.5 Get Course Location and store in correct cell
If OptionLocationVC.Value = True Then
Sheets(Sheets.Count).Range("D7").Value = "Virtual Classroom"
Else
If OptionLocationOnsite.Value = True Then
Sheets(Sheets.Count).Range("D7").Value = "Onsite"
Else
If OptionLocationSite1.Value = True Then
Sheets(Sheets.Count).Range("D7").Value = "site 1"
Else
If OptionLocationSite2.Value = True Then
Sheets(Sheets.Count).Range("D7").Value = "site 2"
End If
End If
End If
'3.6 Get Course Type and store in correct cell
If OptionCourseTypeCourse1.Value = True Then
Sheets(Sheets.Count).Range("D8").Value = "Course1"
Else
If OptionCourseTypeCourse2.Value = True Then
Sheets(Sheets.Count).Range("D8").Value = "Course2"
Else
If OptionCourseTypeOther.Value = True Then
Sheets(Sheets.Count).Range("D8").Value = "Other Third Party"
Else
Sheets(Sheets.Count).Range("D8").Value = "Course Type Unknown"
End If
End If
End If
End If
'3.7 Get Delivery Method and store in correct cell
If CheckBoxTeamsOrZoomTeams.Value = True Then
Sheets(Sheets.Count).Range("F8").Value = "Teams"
Else
If CheckBoxTeamsOrZoomZoom.Value = True Then
Sheets(Sheets.Count).Range("F8").Value = "Zoom"
Else
If CheckBoxTeamsOrZoomNA.Value = True Then
Sheets(Sheets.Count).Range("F8").Value = "N/A"
Else
Sheets(Sheets.Count).Range("F8").Value = "Delivery Method Unknown"
End If
End If
End If
'3.8 Get Public / Closed and store in correct cell
If CheckBoxPublicOrClosedPublic.Value = True Then
Sheets(Sheets.Count).Range("H8").Value = "Public"
Else
If CheckBoxPublicOrClosedClosed.Value = True Then
Sheets(Sheets.Count).Range("H8").Value = "Closed"
Else
Sheets(Sheets.Count).Range("H8").Value = "Public/Closed Unknown"
End If
End If
''''''
'Step 4: Add a new row to the "Course List" table
Dim CourseListTable As ListObject
Set CourseListTable = Sheets("Course List").ListObjects("CourseList")
Dim AddedRow As ListRow
Set AddedRow = CourseListTable.ListRows.Add
With AddedRow
''''''
'Step 5: Take the date information from the userform and convert into an actual date (as recognised by excel)
Dim CourseDateValueAsDate As Date
CourseDateValueAsDate = CDate(TextBoxCourseDate.Text)
''''''
'Step 6: Add the Course Date (as Date), Name, Location, Trainer and Public or Closed Status to the "Course List" Table new row
Dim initials As String
.Range(1) = CourseDateValueAsDate
.Range(2) = CourseNameValue
.Range(3) = Sheets(Sheets.Count).Range("D7").Value
.Range(4) = Sheets(Sheets.Count).Range("D6").Value
.Range(5) = Sheets(Sheets.Count).Range("G6").Value
initials = Left(Sheets(Sheets.Count).Range("D6").Value, 1) & Left(Sheets(Sheets.Count).Range("G6").Value, 1)
.Range(6) = initials
.Range(7) = .Range(4).Value & " " & .Range(5).Value
.Range(8) = Sheets(Sheets.Count).Range("H8").Value
''''''
'Step 7: Change the name of the Tab to be Date, Course Code & Trainer Initials
'Remove / from course date
Dim CourseDate As String
Dim Result As String
CourseDate = TextBoxCourseDate.Text
Result = Replace(CourseDate, "/", "")
'Name tab
Dim ReferenceCode As String
ReferenceCode = Result & CourseNameValue & initials
link = Left(ReferenceCode, 31)
Sheets(Sheets.Count).Name = link
.Range(9) = link
'Step 8: Make the course name a Hyperlink that links to the worksheet
End With
''''''
'Step 9: Then sort the "CourseList" Table by date order.
Dim ws As Worksheet
Dim tbl As ListObject
Dim rng As Range
Set ws = Sheets("Course List")
Set tbl = ws.ListObjects("CourseList")
Set rng = Range("CourseList[Course Date]")
With tbl.Sort
.SortFields.Clear
.SortFields.Add Key:=rng, SortOn:=xlSortOnValues, Order:=xlAscending
.Header = xlYes
.Apply
End With
'Step 10: When all correct call the next Sub.
Unload Me
End Sub
您很少需要激活任何东西才能在代码中使用它
关于这一点的强制性文章：如何避免在Excel VBA中使用Select。
也就是说，你可以随心所欲地创建表单，然后引用它，而无需激活它：
Sub Test()
Dim NewSht As Worksheet
Set NewSht = ThisWorkbook.Worksheets.Add
NewSht.Name = "01102000EXEL1MG"
With ThisWorkbook.Worksheets("Sheet1")
'Add the Hyperlink to A1 in Sheet1.
'You'll need to update the location to your "Course List" table.
'You may also want to update the SubAddress A1 location to somewhere more
'relevant within the new sheet.
.Hyperlinks.Add Anchor:=.Range("A1"), _
Address:="", _
SubAddress:="'" & NewSht.Name & "'!A1", _
TextToDisplay:=NewSht.Name
'Adding a new sheet makes the new sheet active.
'This makes Sheet1 active again. The code runs fine
'without it, you'd just need to manually select Sheet1 when code is finished.
.Activate
End With
End Sub
进一步阅读：
与。。。以块结束