当工作表被添加、删除、复制或更改名称时，工作表列表应更新

Question

我有一个宏（“List_of_sheets”），它创建工作簿中所有工作表的列表，并将该列表放在“表头”字下方的“Sheetlist”表中。

每当我运行宏时，宏都会删除以前的列表并创建一个新列表。每当我删除、添加、复制或更改工作表的名称时，我都会手动执行此操作。但是，我希望它自动运行。

提前致谢！

Sub List_of_sheets()
    Dim objSheet As Worksheet
    Dim intRow   As Integer
    Dim strCol   As Integer
    Dim GCell As Range

    SearchText = "Header"
    Set GCell = Worksheets("Listsheet").Cells.Find(SearchText).Offset(2, -1)

    GCell.End(xlDown).ClearContents

    intRow = GCell.Row
    strCol = GCell.Column

    For Each objSheet In ActiveWorkbook.Sheets
        ActiveWorkbook.Worksheets("Listsheet").Hyperlinks.Add Anchor:=ActiveWorkbook.Worksheets("Listsheet").Cells(intRow, strCol), Address:="", SubAddress:= _
        "'" & objSheet.Name & "'!A1", TextToDisplay:=objSheet.Name
            With ActiveWorkbook.Worksheets("Listsheet").Cells(intRow, strCol).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
    Next objSheet
End Sub

Answer 1

您必须参加工作簿事件，尽管它们不包括工作表名称更改的情况

但作为一种解决方法，您可以使用Workbook_SheetActivate，因为当您更改工作表的名称然后您想查看列表是否已更新时，您必须激活列表工作表

所以在ThisWorkbook 代码窗格中放置以下内容：

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.EnableEvents = False
    List_of_sheets
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Application.EnableEvents = False
    List_of_sheets
    Application.EnableEvents = True
End Sub

您可以考虑对您的代码进行以下重构

Option Explicit

Sub List_of_sheets()
    Dim objSheet As Worksheet
    Dim intRow   As Integer
    Dim strCol   As Integer
    Dim GCell As Range
    Dim SearchText  As String

    SearchText = "Header"
    Set GCell = Worksheets("Listsheet").UsedRange.Find(what:=SearchText, lookat:=xlWhole, LookIn:=xlValues).Offset(2, -1)

    GCell.End(xlDown).ClearContents

    intRow = GCell.Row
    strCol = GCell.Column

    Dim listSheet As Worksheet
    With ActiveWorkbook
        Set listSheet = .Worksheets("Listsheet")
        For Each objSheet In .Sheets
            listSheet.Hyperlinks.Add Anchor:=listSheet.Cells(intRow, strCol), Address:="", SubAddress:= _
            "'" & objSheet.Name & "'!A1", TextToDisplay:=objSheet.Name
            intRow = intRow + 1
        Next objSheet
    End With
    With listSheet.Cells(GCell.Row, strCol).Resize(Sheets.Count).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