首页 >> 技术文章 >> excel2010


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



声明:欢迎各大网站转载本站文章,还请保留一条能直接指向本站的超级链接,谢谢!

时间:2010-5-25 12:36:09,点击:0打印】【关闭

上一篇:微软Excel的2010年开发的挑战 - 足球版 ..
下一篇:

OfficeBa论坛】:阅读本文时遇到了什么问题,可以到论坛进行交流!Excel专家邮件:342327115@qq.com(大家在Excel使用中遇到什么问题,可以咨询此邮箱)。

【声明】:以上文章或资料除注明为Office吧自创或编辑整理外,均为各方收集或网友推荐所得。其中摘录的内容以共享、研究为目的,不存在任何商业考虑。如有任何异议,请与本站联系,本站确认后将立即撤下。谢谢您的支持与理解!


相关评论

我要评论

查看所有评论内容

评论内容