Sub createMenu()
Dim shtcount As Integer
shtcount = Worksheets.Count
'如果一个sheet也没有退出
If shtcount = 0 Or shtcount = 1 Then Exit Sub
Application.ScreenUpdating = False
'从目录之后的sheet开始
Dim beginSheet As Integer
For i = 1 To shtcount
If Sheets(i).Name = "目录" Then
beginSheet = i + 1
End If
Next i
Sheets("目录").Select
Application.StatusBar = "正在生成目录…………请等待!"
'从目录的第6行开始赋值
Dim startLine As Integer
startLine = 6
For i = beginSheet To shtcount
ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(startLine, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
startLine = startLine + 1
Next
For i = 6 To shtcount
Worksheets("目录").Cells(i, 1) = i - 5
Worksheets("目录").Cells(i, 13) = Sheets(i - 1).Cells(2, 18)
Next
Sheets("目录").Select
Dim SelectionCell As Range
Set SelectionCell = Worksheets("目录").Range("B1")
With SelectionCell
.HorizontalAlignment = xlDistributed
.VerticalAlignment = xlCenter
.AddIndent = True
.Font.Bold = False
.Interior.ColorIndex = 34
End With
Application.StatusBar = False
Application.ScreenUpdating = True
Range("A1:AP600").Select
With Selection.Font
.Name = "微软雅黑"
.Size = 10
End With
End Sub
生成Excel的Sheet目录
最新推荐文章于 2024-06-05 14:23:13 发布