以工作表名生动生成目录

来源：http://club.excelhome.net/forum.php?mod=viewthread&tid=469166&page=1

Sub zldccmx()
    Dim i As Integer     '声明几个变量
    Dim ShtCount As Integer
    Dim Nsh As Worksheet
    ShtCount = Worksheets.Count    '取得工作表数量
    If ShtCount < 2 Then Exit Sub     '如果只有一个工作表则退出
    Application.ScreenUpdating = False     '禁止屏幕实时更新
    On Error Resume Next
    Set Nsh = Sheets("目录")
    If Err.Number <> 0 Then
        Set Nsh = Sheets.Add(before:=Sheets(1))    '在最左边插入一个新的工作表
        Nsh.Name = "目录"  '给工作表命名为"目录"
        Err.Clear
    Else
        Nsh.Visible = xlSheetVisible    '让工作表可见
        Nsh.Move before:=Sheets(1)    '将工作表　“目录”　移到最左边
        Nsh.Columns("B:B").Delete Shift:=xlToLeft    '删除B列
    End If
    On Error GoTo Tuichu    '一旦出错就转到 Tuichu 行
    Application.StatusBar = "正在生成目录…………请等待！"  '设置状态栏显示信息
    For i = 2 To ShtCount  '遍历工作表
        '在目录工作表中，依次将其它工作表的名称写进目录工作表的B列，并设置链接（快捷方式）
        Nsh.Hyperlinks.Add Anchor:=Nsh.Cells(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!R2C2", TextToDisplay:=Sheets(i).Name
    Next
    With Nsh.Range("B1")
        .EntireColumn.AutoFit    'B列自动适应宽度
        .Value = "目录"  'B1单元格赋值
        .HorizontalAlignment = xlDistributed  '设置水平对齐方式
        .VerticalAlignment = xlCenter  '垂直居中
        .AddIndent = True     '指明当单元格中文本的对齐方式为水平或垂直等距分布时，文本为自动缩进。
        .Font.Bold = True     '加粗
        .Interior.ColorIndex = 34  '设定底色
    End With
    Application.StatusBar = False   '关闭状态栏显示信息
    Application.ScreenUpdating = True     '打开屏幕实时更新
Tuichu:
End Sub