我有一个宏(“List_of_sheets”),它创建工作簿中所有工作表的列表,并将列表放在“工作表” - 表格下面的“标题”字样。
每当我运行宏时,宏都会删除前一个列表并创建一个新列表。每当我删除,添加,复制或更改工作表名称时,我都会手动执行此操作。但是,我想让它自动运行。
提前致谢!
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
您必须使用Workbooks事件,尽管它们不包括工作表名称更改的情况
但作为一种解决方法,您可以使用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