如果我们手里有一个设置了标题样式的Word长文档，只需要在文档中使用“引用”面板的“目录”命令，即可为文档添加目录，此时点击目录项，就会跳转到文档正文中的相应位置。但是点击正文中的标题，却不能跳转到对应的目录项。此外，如果我们希望正文中相应章节页面的页眉也显示章节标题，那么就必须在章节标题前添加分节符，这样才能实现不同章节的页眉互不影响。在每个章节前插入分节符以及给每节添加不同的页眉，并且实现点击每节的标题和页眉也能跳转到目录的相应位置，对于长文档来说，用手工输入肯定是比较困难的。本文介绍以下三个宏实现这一需求。下面的宏对文档规范化的要求是：每个标题的大纲级别是该标题下面所有内容中大纲级别最高的，并且标题不能是空行。
首先在每个指定级别的标题前添加分节符。推荐添加分页型分节符。如果章节较短，添加连续型分节符，如果某一页上靠前的一部分内容属于上一节的正文，中间出现下一节的标题，由于这一节的页眉属于上一节，这一页页眉的内容与页面上的标题就会对应不上。
Sub 指定级别标题前插入分节符()
Dim pos As Long, styleBodyText$, styleHeading$
styleBodyText = "正文" '正文文本的样式名
styleHeading = "标题 3" '要插入分节符的标题的样式名
outlineHeading = wdOutlineLevel3
Application.ScreenUpdating = False
With Selection
.StartOf wdStory
Do
pos = .Start
.GoToNext wdGoToHeading
If pos = .Start Then Exit Do
If .ParagraphFormat.Style = styleHeading Then
'如果章节较短，可插入连续分节符wdSectionBreakContinuous，
'否则宜插入分页分节符wdSectionBreakNextPage。
'推荐使用分页型分节符，这样页眉中的超链接与节标题可以一一对应
'为了不改变原文档的大纲结构，先将标题降格为正文再插入分节符，然后恢复标题的样式
.ParagraphFormat.Style = styleBodyText
.InsertBreak Type:=wdSectionBreakContinuous
.ParagraphFormat.Style = styleHeading
End If
Loop
End With
Application.ScreenUpdating = True
End Sub
为文档添加目录可以用手工完成。在正文标题插入超链接时以便于跳转到目录项时，需要提供书签定位目录项，作为超链接的链接目标。一个目录项的构成是“标题文本+前导符+页码”，考虑到目录项与标题段落包含了相同的文本内容，从简化编程的角度考虑可以用标题段落文本作为每个目录项的书签名。如果标题段落里包含空格等不合法的标签名字符，可以考虑使用正则表达式或Selection对象的Find方法里的Replace功能将不合法字符全部替换为空字符，只保留合法字符。要注意VBA的Rplace函数无法使用正则表达式，所以不很适用（本文示例文档标题中不包含非法标签名字符，因此未做处理）。取得标题段落的文本比较简单，从目录项中取得标题文本，则需要找到前导符在目录项文本中的位置，然后使用Left函数截取该位置左边的全部文本。这里的困难在于要找到前导符的位置，却无法直观地用一个字符来表示前导符进行查找（例如，用省略号或者圆点字符并不能找到圆点前导符的位置）。这里可以考虑将前导符的ASCII码传给chr函数，由chr函数将前导符的ASCII码转换为字符。先用鼠标在目录项中选择以前导符开头的若干字符，然后运行如下VBA代码，前导符的ASCII码就会输出到立即窗口中：
Sub Test()
Debug.Print Asc(Selection.Characters(1))
End Sub
以下的宏实现了为每个目录项添加书签的功能，标签名也就是对应的标题的文本。须注意的是如果没有在目录最后添加一个空行，书签的Add方法的Range参数不能直接用aPara.Range，否则最后一条目录的书签作用区域会是整个目录，在点击最后一节的标题标题时会跳转到目录开头处。
Sub 为每个目录项添加书签()
Dim aPara As Paragraph, txt$, regEx As New RegExp
regEx.Pattern = "[^一-龟]" '匹配非汉字字符
regEx.Global = True
ActiveDocument.TablesOfContents(1).Range.Select
For Each aPara In Selection.Paragraphs
txt = aPara.Range.Text
If Len(txt) > 1 Then
' 在目录项中截取标题文本作为书签名
txt = Left(txt, InStr(txt, Chr(9)) - 1) '示例文档中目录前导符为chr（9）
txt = regEx.Replace(txt, "") '只取汉字以防出现非法的书签名
'构造一个Range作为Add方法的参数，以免点击最后一节的标题时跳转到目录开头
ActiveDocument.Bookmarks.Add Name:=txt, _
Range:= ActiveDocument.Range(aPara.Range.Start, aPara.Range.End - 1)
'上面这行代码运行时在某台电脑上我碰到过一个很奇怪的问题：提示非法的书签名。删掉参数名称后又成功运行了
End If
Next
End Sub
最后是在每节的节标题区域插入到目录的链接，同时修改各节页眉，添加相应内容并插入链接。我在此前的博客中也写过实现相同功能的代码，但很显然都没有本文中的代码简洁高效：
Sub 处理节标题和页眉的链接()
Dim aSec As Section, pos As Long, txt$, bkName$,aPara As Paragraph, leadingTxt$
Dim regEx As New RegExp
regEx.Pattern = "[^一-龟]" '匹配非汉字字符
leadingTxt = "前导字符串"
Application.ScreenUpdating = False
For Each aSec In ActiveDocument.Sections
With Selection
' 节标题为每节第一个段落
Set aPara = aSec.Range.Paragraphs(1)
'本文处理的标题大纲级别为1，VBA中有相应大纲级别常量定义
'如果文档编写规范，可以省略这个if判断语句
If aPara.OutlineLevel = wdOutlineLevel1 Then
txt = Replace(aPara.Range.Text, Chr(13), "") '去掉段落结尾的回车符
bkName = regEx.Replace(txt, "") '只取汉字以与上面的宏为目录项插入的书签名统一
' Debug.Print txt
' 文档如果没有空白标题行，也可以省略下面的if判断
If Len(txt) >= 1 Then
'将节标题链接到目录，注意在第一个宏中在目录项设置了以标题文本为书签名的书签
ActiveDocument.Hyperlinks.Add Anchor:=aPara.Range, Address:="", _
SubAddress:=bkName
'设置页眉与上一节不同
aSec.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
'在本节页眉区域添加内容并设置超链接链接到目录项
With aSec.Headers(wdHeaderFooterPrimary).Range
'设置页眉中的文本。leadingTxt可以是书名，与节标题间添加一个Tab键
.Text = leadingTxt & vbTab & txt
.Font.Size = 10 ' 字体大小为五号
.ParagraphFormat.TabStops.ClearAll
'在页眉中添加右对齐制表位，将节标题对齐到右边
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16 _
), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
End With
ActiveDocument.Hyperlinks.Add Anchor:=aSec.Headers(wdHeaderFooterPrimary).Range, Address:="", _
SubAddress:=bkName
End If
End If
End With
Next
Application.ScreenUpdating = True
' 恢复视图为页面视图
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
ActiveWindow.ActivePane.View.Type = wdPrintView
End Sub
如果文档中有多级标题，那么处理标题的链接和处理页眉的链接应该分开进行。假定文档目录包含1~3级标题，下面的宏可以建立起文档正文中1~3级标题与对应目录项之间的联系：
Sub 处理节标题的链接()
Dim pos As Long, regEx As New RegExp
regEx.Pattern = "[^一-龟]" '匹配非汉字字符
With Selection
.StartOf wdStory
Do
pos = .Start
.GoToNext wdGoToHeading
If pos = .Start Then Exit Do
If .ParagraphFormat.OutlineLevel < wdOutlineLevel4 Then
txt = Replace(.Paragraphs(1).Range.Text, Chr(13), "")
txt = regEx.Replace(txt, "") '只取汉字以与上面的宏为目录项插入的书签名统一
If Len(txt) >= 1 Then
'将节标题链接到目录，注意在第一个宏中在目录项设置了以标题文本为书签名的书签
ActiveDocument.Hyperlinks.Add Anchor:=.Paragraphs(1).Range, Address:="", _
SubAddress:=txt
End If
End If
Loop
End With
End Sub
对于多级标题的长文档，推荐按最高级别标题对文档进行分节，并使用分页型分节符。这样，每页的页眉中插入的内容为书名以及本页所属最高等级标题的文本。其代码可将上述Sub 处理节标题和页眉的链接()中处理标题链接的代码ActiveDocument.Hyperlinks.Add Anchor:=aPara.Range, Address:="", SubAddress:=txt删除即可。在页眉中插入本页所属节的节标题文本的另一种方法是插入域代码。示例如下：
aSec.Headers(wdHeaderFooterPrimary).LinkToPrevious = False
'在本节页眉区域添加内容并设置超链接链接到目录项
With aSec.Headers(wdHeaderFooterPrimary).Range
.Select
'用模拟键盘输入的方式在页眉中输入内容
Selection.TypeText leadingTxt & vbTab
'输入域代码
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF """ & aPara.Range.ParagraphFormat.Style & """", PreserveFormatting:=True
'对页眉的其他操作，如设置格式等
End With
示例文档处理结果截图如下：
经过上述处理，文档中还会存在当页最高级别标题与页眉中的内容不一致的情形，如下图：
如果要保证每页的页眉与当页最高级别标题保持一致（这种必要性其实不大），那需要将文档的每一页作为一个Section，光标进入本页后再跳转到下一个标题，如果下一个标题不在本页，则本页页眉无需处理。如下一个标题仍在本页，继续跳转到下一个标题，直至跳转到本页中最高级别的标题，取得该标题的文本后修改页眉内容。当然，这里还涉及到光标跳走后恢复位置、每页末尾插入“下一页”型分节符后下一页第一段需不需要首行缩进等许多问题，代码会很复杂，实用性则不强（因为一般来说我们只需要从页眉知道当前页属于哪一本书的第几章即可，书名可由代码中的leadingTxt 提供，第几章则由各Section标题文本提供），闲来无事实现一下用来消遣倒是不错。
扫一扫
554
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
