列出工作表中的工作表名称，超链接它们，并在添加/删除工作表时更新列表

Question

我找到了几个代码，这些代码列出了工作表中的所有工作表名称并超链接它们。我想列出工作表"列表表"中的所有工作表并使它们成为超链接。

以下代码的两个问题：

1(它应该删除以前的列表并插入新列表，以防我添加或删除工作表(子add_list((或子delete_list(((，但是当我删除工作表时，列表会保留旧的工作表名称(因此在创建新列表之前可能不会删除列表(。

2(列表始终在同一单元格中创建并向下创建，但并不总是在工作表"列表表"中创建。这是因为"子add_list(("和"子delete_list(("中的"活动"工作表发生了变化吗？

Sub add_list()
Sheets(4).Copy Before:=Sheets("8")
Call TOC
End Sub

和

Sub delete_sheet()
ActiveSheet.Select
ActiveWindow.SelectedSheets.Delete
Call TOC
End Sub

和

Sub TOC()
Dim objSheet As Object
Dim intRow   As Integer
Dim strCol   As Integer
Dim GCell As Range
SearchText = "Word"
Set GCell = Worksheets("ListSheet").Cells.Find(SearchText).Offset(2, -1)
GCell.End(xlDown).ClearContents
Set objSheet = Excel.Sheets
intRow = GCell.Row
strCol = GCell.Column
For Each objSheet In ActiveWorkbook.Sheets
    With Worksheet
    Cells(intRow, strCol).Select
    Worksheets("ListSheet").Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    "'" & objSheet.Name & "'!A1", TextToDisplay:=objSheet.Name
        With Selection.Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With
    intRow = intRow + 1
    End With
Next

欢迎任何意见、提示或讲座。提前感谢！

Answer 1

(VBA( 编程的几个主要原则没有包含您的原始代码，这可能会导致它失败：

1. 避免Select和ActiveSheet(除非绝对需要(。
2. 使用显式类型和名称声明所有变量(使用显式选项以确保正确使用变量(。
3. 将过程分解为更小的组件(对于您的代码来说不是一个大问题，只是作为奖励:)(

这个重构的代码应该工作得更好：

Option Explicit
Sub addList()
    Sheets(4).Copy Before:=Sheets("8")
    writeTOC
End Sub
Sub deleteSheet()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    writeTOC
End Sub
Sub writeTOC()
    Dim listSheet As Worksheet
    Set listSheet = ThisWorkbook.Worksheets("ListSheet")
    Dim searchText As String
    searchText = "Word"
    Dim gCell As Range
    Set gCell = listSheet.Cells.Find(searchText).Offset(2, -1)
    gCell.End(xlDown).ClearContents
    Dim i As Integer
    Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        listSheet.Hyperlinks.Add Anchor:=gCell.Offset(i), Address:="", SubAddress:="'" & sht.Name & "!A1", TextToDisplay:=sht.Name
        formatLinkCell gCell.Offset(i)
        i = i + 1
    Next
End Sub
Sub formatLinkCell(rng As Range)
    With rng.font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub