excel自动生成目录

 On Error GoTo Tuichu

 Dim i As Integer

 Dim ShtCount As Integer

 Dim SelectionCell As Range

 ShtCount = Worksheets.Count

 If ShtCount = 0 Or ShtCount = 1 Then Exit Sub

 Application.ScreenUpdating = False

 For i = 1 To ShtCount

If Sheets(i).Name = "目录" Then

 Sheets("目录").Move Before:=Sheets(1)

 End If

 Next i

 If Sheets(1).Name <> "目录" Then

 ShtCount = ShtCount + 1

 Sheets(1).Select

 Sheets.Add

 Sheets(1).Name = "目录"

 End If

 Sheets("目录").Select

 Columns("B:B").Delete Shift:=xlToLeft

 Application.StatusBar = "正在生成目录…………请等待！"

 For i = 2 To ShtCount

 ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _

 "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:="'" & Sheets(i).Name

 Next

 Sheets("目录").Select

 Columns("B:B").AutoFit

 Cells(1, 2) = "目录"

 Set SelectionCell = Worksheets("目录").Range("B1")

 With SelectionCell

 .HorizontalAlignment = xlDistributed

 .VerticalAlignment = xlCenter

 .AddIndent = True

 .Font.Bold = True

 .Interior.ColorIndex = 34

 End With

 Application.StatusBar = False

 Application.ScreenUpdating = True

 Tuichu:

 End Sub