生成Excel的Sheet目录

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