Question

我找到了几个代码，列出了工作表中的所有工作表名称并将其超链接。我想列出表单“ListSheet”中的所有表格并使它们成为超链接。

以下代码存在两个问题：

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

2）列表始终在同一单元格中创建并向下，但并不总是在“ListSheet”表单中创建。那是因为在“sub add_list（）”和“sub 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）编程的几个主要原则没有包含原始代码，可能导致它失败：

避免使用Select和ActiveSheet（绝对需要时除外）。
使用显式类型和名称声明所有变量（使用Option Explicit确保正确使用变量）。
将程序分解为更小的组件（对于您的代码来说不是一个大问题，只是奖励：））

这个重构的代码应该可以更好地工作：

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

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

1 个答案: