手动更新首页目录功能

手动更新首页目录功能是一个基于 Excel/WPS VBA 的工作表目录生成工具，主要用于在工作簿的“首页”工作表中，自动生成当前工作簿所有工作表的目录清单，并为每个工作表名称添加可点击跳转的超链接。

该功能适合用于全成本测算模板、工程清单模板、报价模板、台账系统、项目管理表、多工作表汇总文件等场景。当工作簿中包含大量工作表时，用户可以通过“首页目录”快速跳转到目标工作表，提升浏览和操作效率。

本版本为 2.5 WPS适配优化版，针对 Excel 与 WPS 表格环境进行了兼容增强，包含环境状态保存与恢复、批量数组写入、超链接安全添加、状态栏提示、错误处理、WPS 属性兼容访问等优化逻辑，适合在实际模板中长期使用。

📌 核心功能一览

功能 说明
手动更新目录 运行 CreateTOC 宏后自动刷新首页目录
自动扫描工作表 遍历当前工作簿内所有工作表
自动排除首页 目录表“首页”本身不会列入目录
自动编号 为每个工作表生成序号
自动生成超链接 点击目录中的工作表名称即可跳转到对应工作表 A1
多列目录布局 支持 3 组“序号 + 名称”并排显示
最大目录容量限制 默认支持最多 96 个工作表目录项
批量写入数据 使用数组一次性写入目录区域，提高执行效率
清除旧目录 运行前自动清除旧内容和旧超链接
统一设置格式 自动设置字体、字号、对齐方式
状态栏提示 生成过程中显示当前处理状态
Excel/WPS 兼容 使用安全属性访问方式，提升 WPS 兼容性
错误处理完善 出错时提示错误号与错误描述，并恢复环境状态

⚙️ 项目结构说明

模块组成

模块 类型 作用
Module1 标准模块 存放 CreateTOC 主过程及辅助函数
首页 工作表 承载自动生成的目录内容
更新按钮 表单控件/形状按钮 可绑定 CreateTOC 宏，用于手动刷新目录

默认目录区域

参数 默认值 说明
目录表名称 首页 用于生成目录的工作表
起始行 第 3 行 目录从第 3 行开始
起始列 第 4 列，即 D 列 目录从 D 列开始
最大行数 32 行 每组目录最多显示 32 项
最大列数 6 列 3 组“序号 + 名称”并排显示
最大目录项 96 项 32 行 × 3 组

目录布局示意

默认从 D3:I34 生成目录，结构如下：

D列 E列 F列 G列 H列 I列
序号 工作表名称 序号 工作表名称 序号 工作表名称
1 表1 33 表33 65 表65
2 表2 34 表34 66 表66
… … … … … …
32 表32 64 表64 96 表96

🚀 使用方式

第一步：准备“首页”工作表

请确保当前工作簿中存在名为：

1
首页

的工作表。

如果目录页名称不是“首页”，需要修改代码中的对应名称。

第二步：打开 VBA 编辑器

在 Excel 或 WPS 表格中按下：

1
Alt + F11

进入 VBA 编辑器。

第三步：插入标准模块

在 VBA 编辑器中依次点击：

1
插入 → 模块

新建一个标准模块，例如 Module1。

第四步：粘贴完整代码

将本文下方的完整 VBA 代码复制到标准模块中。

第五步：运行宏

可以通过以下方式运行：

1
开发工具 → 宏 → CreateTOC → 运行

也可以在“首页”工作表中添加按钮，并将按钮绑定到：

1
CreateTOC

以后点击按钮即可手动更新首页目录。

📋 完整代码

标准模块代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
' ==========================================
' 功能：手动更新首页目录模块
' 作者：XLCS-Jgwy
' 日期：2026-06-11
' 版本：2.5（WPS适配优化版）
' ==========================================

Option Explicit

Private Const TOC_START_ROW As Long = 3
Private Const TOC_START_COL As Long = 4
Private Const TOC_MAX_ROWS As Long = 32
Private Const TOC_MAX_COLS As Long = 6

Sub CreateTOC()

    On Error GoTo EH

    Dim ws As Worksheet
    Dim tocSheet As Worksheet
    Dim i As Long
    Dim rowCount As Long
    Dim colOffset As Long
    Dim pairCount As Long
    Dim maxItems As Long
    Dim totalSheets As Long
    Dim arr() As Variant
    Dim rngTOC As Range
    Dim savedScreenUpdating As Boolean
    Dim savedEnableEvents As Variant
    Dim savedCalculation As Variant
    Dim hasEnableEvents As Boolean
    Dim hasCalculation As Boolean

    '========================
    ' 一、保存并关闭环境
    '========================
    savedScreenUpdating = Application.ScreenUpdating

    hasEnableEvents = TOC_TryGetAppProperty("EnableEvents", savedEnableEvents)
    hasCalculation = TOC_TryGetAppProperty("Calculation", savedCalculation)

    Application.ScreenUpdating = False
    TOC_TrySetAppProperty "EnableEvents", False

    ' 目录生成不涉及公式计算，可以不切手动模式；但关闭可避免干扰
    TOC_TrySetAppProperty "Calculation", -4135  ' xlCalculationManual

    '========================
    ' 二、获取目录表
    '========================
    Set tocSheet = TOC_GetWorksheetSafe("首页")

    If tocSheet Is Nothing Then
        MsgBox "目录表未找到，请检查工作表名称！", vbExclamation, "CreateTOC"
        GoTo CleanUp
    End If

    '========================
    ' 三、初始化参数
    '========================
    pairCount = TOC_MAX_COLS \ 2
    maxItems = TOC_MAX_ROWS * pairCount

    Set rngTOC = tocSheet.Range( _
        tocSheet.Cells(TOC_START_ROW, TOC_START_COL), _
        tocSheet.Cells(TOC_START_ROW + TOC_MAX_ROWS - 1, TOC_START_COL + TOC_MAX_COLS - 1))

    ' 清除旧内容和超链接
    rngTOC.ClearContents

    On Error Resume Next
    rngTOC.Hyperlinks.Delete
    On Error GoTo EH

    '========================
    ' 四、构建目录数据数组
    '========================
    ReDim arr(1 To TOC_MAX_ROWS, 1 To TOC_MAX_COLS)

    totalSheets = ThisWorkbook.Worksheets.Count
    i = 0

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> tocSheet.Name Then

            i = i + 1

            If i > maxItems Then
                MsgBox "目录区域已满（最多 " & maxItems & " 项），多余工作表未列入目录。", _
                       vbExclamation, "CreateTOC"
                Exit For
            End If

            rowCount = ((i - 1) Mod TOC_MAX_ROWS) + 1
            colOffset = (Int((i - 1) / TOC_MAX_ROWS) * 2) + 1

            arr(rowCount, colOffset) = i
            arr(rowCount, colOffset + 1) = ws.Name

        End If

    Next ws

    '========================
    ' 五、批量写入目录区域
    '========================
    rngTOC.Value = arr

    '========================
    ' 六、添加超链接
    '========================
    TOC_SetStatusBarSafe "正在生成目录超链接..."

    i = 0

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> tocSheet.Name Then

            i = i + 1
            If i > maxItems Then Exit For

            rowCount = TOC_START_ROW + ((i - 1) Mod TOC_MAX_ROWS)
            colOffset = Int((i - 1) / TOC_MAX_ROWS) * 2

            TOC_AddHyperlinkSafe tocSheet, _
                                 rowCount, _
                                 TOC_START_COL + colOffset + 1, _
                                 ws.Name

            ' 每20个更新一次状态栏
            If i Mod 20 = 0 Then
                TOC_SetStatusBarSafe "正在生成目录超链接 (" & i & ")..."
            End If

        End If

    Next ws

    '========================
    ' 七、统一设置格式
    '========================
    TOC_SetStatusBarSafe "正在设置目录格式..."

    ' 字体统一
    On Error Resume Next

    With rngTOC.Font
        .Name = "微软雅黑"
        .Size = 10
        .Color = RGB(0, 0, 0)
        .Underline = xlUnderlineStyleNone
    End With

    On Error GoTo EH

    ' 序号列居中，名称列左对齐
    Dim colPair As Long
    Dim rngSeq As Range
    Dim rngName As Range

    For colPair = 0 To pairCount - 1

        ' 序号列
        Set rngSeq = tocSheet.Range( _
            tocSheet.Cells(TOC_START_ROW, TOC_START_COL + colPair * 2), _
            tocSheet.Cells(TOC_START_ROW + TOC_MAX_ROWS - 1, TOC_START_COL + colPair * 2))

        With rngSeq
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

        ' 名称列
        Set rngName = tocSheet.Range( _
            tocSheet.Cells(TOC_START_ROW, TOC_START_COL + colPair * 2 + 1), _
            tocSheet.Cells(TOC_START_ROW + TOC_MAX_ROWS - 1, TOC_START_COL + colPair * 2 + 1))

        With rngName
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
        End With

    Next colPair

    '========================
    ' 八、完成提示
    '========================
    MsgBox "XLCS模版目录已更新完成！", vbInformation, "CreateTOC"

CleanUp:
    On Error Resume Next

    TOC_ClearStatusBarSafe

    Application.ScreenUpdating = savedScreenUpdating

    If hasEnableEvents Then TOC_TrySetAppProperty "EnableEvents", savedEnableEvents
    If hasCalculation Then TOC_TrySetAppProperty "Calculation", savedCalculation

    Application.CutCopyMode = False

    Exit Sub

EH:
    MsgBox "目录生成失败：" & vbCrLf & _
           "错误号：" & Err.Number & vbCrLf & _
           "描述：" & Err.Description, vbCritical, "CreateTOC"

    Resume CleanUp

End Sub

'===============================================================
' WPS 环境检测（带缓存）
'===============================================================
Public Function IsWPSEnvironment() As Boolean

    Static cachedResult As Boolean
    Static isChecked As Boolean

    If Not isChecked Then

        On Error Resume Next

        cachedResult = (InStr(1, Application.Name, "WPS", vbTextCompare) > 0)

        If Not cachedResult Then
            cachedResult = (InStr(1, Application.Name, "Kingsoft", vbTextCompare) > 0)
        End If

        On Error GoTo 0

        isChecked = True

    End If

    IsWPSEnvironment = cachedResult

End Function

'===============================================================
' 私有辅助函数（TOC_ 前缀避免与其他模块冲突）
'===============================================================
Private Function TOC_GetWorksheetSafe(ByVal sheetName As String) As Worksheet

    On Error Resume Next
    Set TOC_GetWorksheetSafe = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0

End Function

Private Sub TOC_AddHyperlinkSafe(ByVal tocSheet As Worksheet, _
                                  ByVal targetRow As Long, _
                                  ByVal targetCol As Long, _
                                  ByVal sheetName As String)

    Dim anchorCell As Range

    Set anchorCell = tocSheet.Cells(targetRow, targetCol)

    On Error Resume Next

    ' WPS 和 Excel 统一写法：先确保值存在，再添加超链接
    anchorCell.Value = sheetName

    ' 删除已有超链接（防止重复）
    anchorCell.Hyperlinks.Delete

    ' 添加超链接
    tocSheet.Hyperlinks.Add _
        Anchor:=anchorCell, _
        Address:="", _
        SubAddress:="'" & sheetName & "'!A1", _
        TextToDisplay:=sheetName

    ' WPS 部分版本 Hyperlinks.Add 可能静默失败，不报错
    On Error GoTo 0

End Sub

Private Function TOC_TryGetAppProperty(ByVal propertyName As String, ByRef propertyValue As Variant) As Boolean

    On Error GoTo Failed

    propertyValue = CallByName(Application, propertyName, VbGet)
    TOC_TryGetAppProperty = True

    Exit Function

Failed:
    propertyValue = Empty
    TOC_TryGetAppProperty = False
    Err.Clear

End Function

Private Function TOC_TrySetAppProperty(ByVal propertyName As String, ByVal propertyValue As Variant) As Boolean

    On Error GoTo Failed

    CallByName Application, propertyName, VbLet, propertyValue
    TOC_TrySetAppProperty = True

    Exit Function

Failed:
    TOC_TrySetAppProperty = False
    Err.Clear

End Function

Private Sub TOC_SetStatusBarSafe(ByVal statusText As String)

    On Error Resume Next
    Application.StatusBar = statusText
    On Error GoTo 0

End Sub

Private Sub TOC_ClearStatusBarSafe()

    On Error Resume Next
    Application.StatusBar = False
    On Error GoTo 0

End Sub

🔍 技术要点详解

1. 使用常量统一控制目录区域

代码开头使用常量定义目录生成位置和容量：

1
2
3
4
Private Const TOC_START_ROW As Long = 3
Private Const TOC_START_COL As Long = 4
Private Const TOC_MAX_ROWS As Long = 32
Private Const TOC_MAX_COLS As Long = 6

含义如下：

常量 说明
TOC_START_ROW 目录起始行
TOC_START_COL 目录起始列
TOC_MAX_ROWS 每组目录最大行数
TOC_MAX_COLS 目录区域总列数

默认情况下，目录区域为：

1
D3:I34

即 6 列、32 行，按“序号 + 工作表名称”的形式分成 3 组。

2. 自动获取“首页”目录表

代码通过安全函数获取“首页”工作表：

1
Set tocSheet = TOC_GetWorksheetSafe("首页")

如果当前工作簿中不存在“首页”，则会提示：

1
MsgBox "目录表未找到，请检查工作表名称！"

这样可以避免工作表名称错误导致程序中断。

3. 自动清除旧目录和旧超链接

每次重新生成目录前，代码会先清空原目录区域内容：

1
rngTOC.ClearContents

同时删除旧超链接：

1
rngTOC.Hyperlinks.Delete

这样可以避免重复运行后出现旧目录残留、超链接重复或跳转错误的问题。

4. 使用数组批量写入目录

目录数据不是逐个单元格写入，而是先写入数组：

1
ReDim arr(1 To TOC_MAX_ROWS, 1 To TOC_MAX_COLS)

遍历工作表时，将序号和工作表名称保存到数组中：

1
2
arr(rowCount, colOffset) = i
arr(rowCount, colOffset + 1) = ws.Name

最后一次性写入目录区域：

1
rngTOC.Value = arr

这种方式比逐个单元格写入速度更快，尤其适合工作表数量较多的模板。

5. 自动生成多列目录布局

代码通过以下逻辑计算目录项所在行列：

1
2
rowCount = ((i - 1) Mod TOC_MAX_ROWS) + 1
colOffset = (Int((i - 1) / TOC_MAX_ROWS) * 2) + 1

效果是：

  • 第 1 至第 32 个工作表写入第 1 组目录
  • 第 33 至第 64 个工作表写入第 2 组目录
  • 第 65 至第 96 个工作表写入第 3 组目录

这种布局比单列目录更节省首页空间。

6. 为工作表名称添加跳转超链接

代码使用以下过程为工作表名称添加超链接：

1
TOC_AddHyperlinkSafe tocSheet, rowCount, targetCol, ws.Name

核心语句为：

1
2
3
4
5
tocSheet.Hyperlinks.Add _
    Anchor:=anchorCell, _
    Address:="", _
    SubAddress:="'" & sheetName & "'!A1", _
    TextToDisplay:=sheetName

其中：

参数 说明
Anchor 超链接所在单元格
Address 外部链接地址，此处为空
SubAddress 工作簿内部跳转地址
TextToDisplay 显示的工作表名称

单击目录中的工作表名称后，即可跳转到对应工作表的 A1 单元格。

7. Excel/WPS 属性访问兼容处理

部分 WPS 环境对 Application.EnableEvents、Application.Calculation 等属性支持不完全，直接访问可能报错。

因此代码封装了安全访问函数：

1
2
TOC_TryGetAppProperty
TOC_TrySetAppProperty

内部使用：

1
2
CallByName Application, propertyName, VbGet
CallByName Application, propertyName, VbLet, propertyValue

这样可以在 Excel 和 WPS 中尽量兼容运行，避免因某些属性不可用而导致宏整体失败。

8. 保存并恢复应用环境

代码执行前保存环境状态：

1
2
3
savedScreenUpdating = Application.ScreenUpdating
hasEnableEvents = TOC_TryGetAppProperty("EnableEvents", savedEnableEvents)
hasCalculation = TOC_TryGetAppProperty("Calculation", savedCalculation)

执行过程中关闭屏幕刷新、事件与自动计算：

1
2
3
Application.ScreenUpdating = False
TOC_TrySetAppProperty "EnableEvents", False
TOC_TrySetAppProperty "Calculation", -4135

结束后统一恢复：

1
2
3
Application.ScreenUpdating = savedScreenUpdating
If hasEnableEvents Then TOC_TrySetAppProperty "EnableEvents", savedEnableEvents
If hasCalculation Then TOC_TrySetAppProperty "Calculation", savedCalculation

这样可以减少闪烁、提升速度，并避免因运行宏改变用户原本的 Excel/WPS 设置。

9. 使用状态栏显示执行进度

代码在生成过程中通过状态栏提示当前状态：

1
TOC_SetStatusBarSafe "正在生成目录超链接..."

每处理 20 个目录项更新一次：

1
2
3
If i Mod 20 = 0 Then
    TOC_SetStatusBarSafe "正在生成目录超链接 (" & i & ")..."
End If

执行结束后清空状态栏：

1
TOC_ClearStatusBarSafe

这种方式比频繁弹窗更友好，适合批量处理过程。

10. 统一设置目录格式

目录生成后，代码统一设置字体样式：

1
2
3
4
5
6
With rngTOC.Font
    .Name = "微软雅黑"
    .Size = 10
    .Color = RGB(0, 0, 0)
    .Underline = xlUnderlineStyleNone
End With

同时分别设置序号列与名称列的对齐方式：

1
2
序号列：居中对齐
名称列：左对齐

使首页目录更加整齐、美观。

📊 相比普通目录生成代码的优化改进

优化项 普通代码 本版本
工作表扫描 简单遍历 自动排除首页
写入方式 单元格逐项写入 数组批量写入，速度更快
目录布局 通常单列显示 3 组多列布局，更节省空间
超链接处理 可能重复添加 添加前删除旧超链接
WPS 兼容 容易因属性不支持报错 使用安全属性读写函数
错误处理 通常较简单 统一错误捕获并恢复环境
环境恢复 可能遗漏恢复设置 保存并恢复屏幕刷新、事件、计算模式
状态提示 无进度提示 使用状态栏显示处理状态
格式设置 手动调整 自动统一字体和对齐方式
容量控制 无限制提示 超出最大项时主动提醒
代码冲突 辅助函数易重名 使用 TOC_ 前缀降低冲突
维护性 参数分散 常量集中管理

💡 可自定义参数

修改目录表名称

默认目录表名称为：

1
Set tocSheet = TOC_GetWorksheetSafe("首页")

如果你的目录表叫“目录”，可以改为：

1
Set tocSheet = TOC_GetWorksheetSafe("目录")

修改目录起始位置

默认从 D3 开始生成目录：

1
2
Private Const TOC_START_ROW As Long = 3
Private Const TOC_START_COL As Long = 4

如果希望从 B5 开始，可以修改为：

1
2
Private Const TOC_START_ROW As Long = 5
Private Const TOC_START_COL As Long = 2

修改每组目录行数

默认每组显示 32 行：

1
Private Const TOC_MAX_ROWS As Long = 32

如果首页空间较大，可以改为 40：

1
Private Const TOC_MAX_ROWS As Long = 40

修改目录列数

默认目录区域总列数为 6，即 3 组“序号 + 名称”：

1
Private Const TOC_MAX_COLS As Long = 6

如果只需要 2 组，可以改为：

1
Private Const TOC_MAX_COLS As Long = 4

如果需要 4 组，可以改为：

1
Private Const TOC_MAX_COLS As Long = 8

注意：TOC_MAX_COLS 建议使用偶数，因为每组目录需要两列：一列序号、一列工作表名称。

修改跳转目标单元格

当前超链接跳转到对应工作表的 A1：

1
SubAddress:="'" & sheetName & "'!A1"

如果希望跳转到 A2，可改为：

1
SubAddress:="'" & sheetName & "'!A2"

如果希望跳转到 B5，可改为：

1
SubAddress:="'" & sheetName & "'!B5"

🛠️ 按钮设置建议

推荐添加“更新目录”按钮

可以在“首页”工作表中放置一个按钮，绑定宏：

1
CreateTOC

按钮文字建议设置为：

1
更新目录

或：

1
刷新首页目录

也可以使用：

1
生成工作表目录

表单按钮推荐命名

按钮名称 建议用途
btnUpdateTOC 更新目录
btnCreateTOC 生成目录
btnRefreshTOC 刷新目录
btnHomeTOC 首页目录
btnXLCS_TOC XLCS目录按钮

虽然代码不依赖按钮名称，但规范命名有利于模板后期维护。

📐 推荐布局方式

位置 说明
首页顶部右侧 用户打开首页即可看到更新按钮
目录标题旁边 与目录功能关联明显
首页导航区 适合模板化系统
冻结窗格区域 滚动时仍可见
首页底部说明区 不影响目录主体展示

⚠️ 注意事项

  1. 当前代码默认目录工作表名称为 首页，请确保工作簿中存在该工作表。
  2. “首页”工作表本身不会列入目录。
  3. 默认目录区域为 D3:I34，运行前会清除该区域原有内容和超链接。
  4. 如果该区域已有重要内容，请先调整常量中的起始行、起始列、最大行数或最大列数。
  5. 默认最多生成 96 个目录项，超出部分不会列入目录，并会弹出提示。
  6. 如果工作表名称包含特殊字符，代码已使用单引号包裹工作表名，通常可正常跳转。
  7. 如果首页工作表被保护，可能导致清除内容、写入数据或添加超链接失败。
  8. WPS 部分版本的 Hyperlinks.Add 可能存在静默失败情况，建议生成后点击测试。
  9. 如果宏运行后没有生成目录，请检查宏安全设置是否允许运行 VBA。
  10. 如果工作簿中包含隐藏工作表，当前代码仍会将其列入目录；如需排除隐藏表，可进一步扩展判断。

📦 常见问题

Q1：为什么提示“目录表未找到”？

原因是当前工作簿中没有名为：

1
首页

的工作表。

解决方法：

  • 将目录工作表重命名为“首页”
  • 或修改代码中的：
1
Set tocSheet = TOC_GetWorksheetSafe("首页")

改为你的实际目录表名称。

Q2：为什么目录没有超链接？

可能原因包括：

  • WPS 当前版本对超链接添加支持异常
  • 首页工作表处于保护状态
  • 目录区域不可编辑
  • 工作表名称异常
  • 宏运行过程中被中断

建议先解除首页保护，再重新运行 CreateTOC。

Q3：可以不显示序号，只显示工作表名称吗？

可以，但需要调整数组写入逻辑和目录列布局。

当前代码每组使用两列：

1
序号 + 工作表名称

如果只显示名称，可将目录列设计为单列或多列名称布局。

Q4：隐藏工作表会不会列入目录？

会。

当前代码遍历的是：

1
ThisWorkbook.Worksheets

没有判断工作表是否隐藏。

如果需要排除隐藏表，可以在遍历时增加判断：

1
If ws.Visible = xlSheetVisible Then

Q5：可以自动在打开工作簿时更新目录吗？

可以。

在 ThisWorkbook 模块中添加：

1
2
3
Private Sub Workbook_Open()
    Call CreateTOC
End Sub

但如果工作簿工作表较多，打开时自动生成可能稍慢。一般建议保留为手动更新，更稳妥。

Q6：可以跳转到每张表的指定区域吗？

可以。

修改超链接中的目标地址即可，例如跳转到 A2：

1
SubAddress:="'" & sheetName & "'!A2"

Q7：WPS 表格可以用吗？

通常可以使用。

本版本已经针对 WPS 做了适配优化，包括：

  • 安全读取 EnableEvents
  • 安全读取 Calculation
  • 安全设置状态栏
  • 安全添加超链接
  • 避免属性不兼容导致整体中断

但不同 WPS 版本差异较大，建议在正式模板发布前测试。

💡 扩展方向

方向 说明
排除隐藏表 只将可见工作表列入目录
自定义排序 按名称、编号、颜色或指定规则排序
增加返回首页按钮 在每张工作表添加返回首页链接
目录分组 按专业、阶段、类型对工作表分组
自动生成按钮 在首页自动创建“更新目录”按钮
双向导航 首页跳转到分表，分表可一键回首页
显示工作表状态 在目录中标记隐藏、保护、空表等状态
增加工作表颜色标识 根据工作表标签颜色设置目录字体或底色
目录搜索 增加搜索框快速定位工作表名称
自动编号同步 根据目录顺序自动重命名或标记工作表

📋 排除隐藏工作表示例

如果希望隐藏工作表不显示在目录中，可以将遍历部分增加判断。

示例思路：

1
2
3
4
5
6
7
8
9
10
11
For Each ws In ThisWorkbook.Worksheets

    If ws.Name <> tocSheet.Name Then
        If ws.Visible = xlSheetVisible Then

            ' 写入目录逻辑

        End If
    End If

Next ws

这样只有可见工作表会进入首页目录。

📋 添加返回首页链接思路

如果希望每个工作表都能返回“首页”，可以扩展一个宏，批量给各表 A1 添加返回首页链接：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub AddBackHomeLinks()

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "首页" Then

            ws.Range("A1").Value = "返回首页"

            ws.Hyperlinks.Add _
                Anchor:=ws.Range("A1"), _
                Address:="", _
                SubAddress:="'首页'!A1", _
                TextToDisplay:="返回首页"

        End If

    Next ws

    MsgBox "返回首页链接已添加完成！", vbInformation

End Sub

该功能可与 CreateTOC 配合使用，实现完整的工作簿导航体系。

📞 技术支持

官网：

求助建议： http://xlcs.de/

邮件联系： admin@fdc.sd

📷 效果展示

手动更新首页目录功能

XLCS — 让全成本测算更智能