Excel - 将目录添加到工作簿

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 &amp; 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:="'" &amp; wsSheet.Name &amp; "'!A1", _
            TextToDisplay:=wsSheet.Name
            lnPages = wsSheet.PageSetup.Pages().Count
            .Cells(lnRow, 2).Value = "'" &amp; lnCount &amp; "-" &amp; 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

正文

打开变量强制声明开关

声明公有的无参数子过程 Create_TOC

声明 Workbook 对象类型变量 wbBook
声明 Worksheet 对象类型变量 wsActive, wsSheet
声明 Long 数据类型变量 lnRow, lnPages, lnCount

为变量 wbBook 分配 Application 对象的 ActiveWorkbook 属性所返回的 Workbook 对象的引用，
    该对象表示激活窗口中的工作簿（顶部的窗口）

进入 Application 对象领域
    赋值 False 于 DisplayAlerts 属性 ，
        禁止宏运行期间的提示与通告信息
    赋值 False 于 ScreenUpdating 属性
退出领域

使能错误处理例行程序，恢复其后代码

进入 wbBook 引用之 Workbook 对象领域
    访问 Worksheets 属性获得 Sheets 对象，
        通过表名称在 Sheets 对象中索引获得 TOC 的 Worksheet 对象，
        调用 Worksheet 对象的 Delete 方法，
        删除表 TOC
    访问 Worksheets 属性获得 Sheets 对象，
        调用 Sheets 对象的 Add 方法，
        并设置 Before 参数为
        通过访问 Worksheets 属性获得 Sheets 对象中索引号为 1 的对象
        Add 方法在指定位置创建并激活新工作表
退出领域

去活错误处理例行程序

为变量 wsActive 分配 wbBook 变量所引用的 Workbook 对象的 ActiveSheet 属性返回的 Worksheet 对象，
    表示 wsBook 中的激活表

进入 wsActive 引用之 Worksheet 对象领域
    设置 name 属性的值为字符串"TOC"，表示 Worksheet 对象的名称
    进入 Range 属性所返回的 Range 对象领域
        设置 Value 属性的值为 Array 函数的返回值
        设置 Bold 属性的值为 True
    退出领域
退出领域

最后编辑于：2018.06.08 10:45:40