VBA自学应用（5）——为工作簿建立目录

平时我们工作表太多了，想给他建立一个目录吗，该怎么做到呢？这里我以自己常用的为例。

如图我有很多日期的工作表，现在我要把它做成下面的效果

这里注意：我是以每个工作表第一列作为工作表目录的名称，所以在每个工作表第一列的的字段都会列入"目录"工作表

代码如下：

Sub 刷新()
    Application.ScreenUpdating = False
    Dim sht As Worksheet
    Dim i As Long, j As Long, k As Long
    Cells.Clear
    Range("a1:b1") = Array("日期", "目录")
    With Range("a1:b1")
        .Font.Bold = True
        .Font.Color = -11489280
    End With
    k = Cells(Rows.Count, 2).End(xlUp).Row + 1
    For Each sht In worksheets
        If sht.Name <> "目录" Then
            ActiveSheet.Hyperlinks.Add Cells(k, 1), Address:="", _
            SubAddress:="'" & sht.Name & "'!" & sht.Range("a1").Address
            With Cells(k, 1)
                .Value = sht.Name
                .Font.Bold = True
                .Font.Color = 255
            End With
            '工作表名称目录
            j = sht.Cells(Rows.Count, 1).End(xlUp).Row
            For i = 1 To j
                If sht.Cells(i, 1).Value <> "" Then
                    a = sht.Cells(i, 1).Address(0, 0)
                    ActiveSheet.Hyperlinks.Add Cells(k, 2), Address:="", _
                    SubAddress:="'" & sht.Name & "'!" & sht.Cells(i, 1).Address(0, 0), _
                    TextToDisplay:="'" & sht.Cells(i, 1).Value
                    k = k + 1
                End If
            Next
            '内容目录
        End If
    Next
    Cells.EntireColumn.AutoFit
    Cells.VerticalAlignment = xlCenter
    Cells.HorizontalAlignment = xlLeft
    Range("a1:b1").HorizontalAlignment = xlCenter
    Application.ScreenUpdating = True
End Sub

最后，我们在工作簿事件中找到对应事件

在对应事件中下入如下代码

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{F1}"
End Sub

Private Sub workbook_Open()
    Sheet1.Activate
    Application.OnKey "^{F1}", "返回"
End Sub

再在模块中插入返回工作表的代码

Sub 返回()
    worksheets("目录").Activate
End Sub

这样我们就可以用ctrl+F1快捷键快速返回工作表目录啦！