Excel 2010创建一个目录超链接编程

创建一个目录超链接编程


几个星期前，我们发布了用于创建您的工作簿的目录代码示例。

丹尼斯提供了另一种与此创建超链接目录与代码示例的方式。丹尼斯的代码使用PageSetup.Pages（）。Count属性，在Excel 2007年推出，以计算每个表的页数。此外，在目录中的链接到其各自的表项，以改善屏幕的工作簿导航。
Option Explicit

Sub Create_TOC()
Dim wbBook As Workbook
Dim wsActive As Worksheet
Dim wsSheet As Worksheet

Dim lnRow As Long
Dim lnPages As Long
Dim lnCount As Long

Set wbBook = ActiveWorkbook

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'If the TOC sheet already exist delete it and add a new
'worksheet.

On Error Resume Next
With wbBook
    .Worksheets("TOC").Delete
    .Worksheets.Add Before:=.Worksheets(1)
End With
On Error GoTo 0

Set wsActive = wbBook.ActiveSheet
With wsActive
    .Name = "TOC"
    With .Range("A1:B1")
        .Value = VBA.Array("Table of Contents", "Sheet # - # of Pages")
        .Font.Bold = True
    End With
End With

lnRow = 2
lnCount = 1

'Iterate through the worksheets in the workbook and create
'sheetnames, add hyperlink and count & write the running number
'of pages to be printed for each sheet on the TOC sheet.
For Each wsSheet In wbBook.Worksheets
    If wsSheet.Name <> wsActive.Name Then
        wsSheet.Activate
        With wsActive
            .Hyperlinks.Add .Cells(lnRow, 1), "", _
            SubAddress:="'" & wsSheet.Name & "'!A1", _
            TextToDisplay:=wsSheet.Name
            lnPages = wsSheet.PageSetup.Pages().Count
            .Cells(lnRow, 2).Value = "'" & lnCount & "-" & lnPages
        End With
        lnRow = lnRow + 1
        lnCount = lnCount + 1
    End If
Next wsSheet

wsActive.Activate
wsActive.Columns("A:B").EntireColumn.AutoFit

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub