☰

使用 VBA 遍历文档并插入交叉引用

tag-icon • tag-icon microsoft-word pdf macros cross-reference
使用 VBA 遍历文档并插入交叉引用

我在 Word 2016 中使用邮件合并，然后将合并结果保存为 PDF。为了在保存为 PDF 时不破坏合并文档中的超链接目录，我必须在保存为 PDF 之前在合并结果中构建目录。只要我记得在合并后插入目录，这种方法就有效。我编写了一个简单的宏来帮我完成这个任务。

Sub AddTableofContents()
    With ActiveDocument
        .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
            True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
            LowerHeadingLevel:=1, IncludePageNumbers:=True, AddedStyles:="", _
            UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
            True
        .TablesOfContents(1).TabLeader = wdTabLeaderDots
        .TablesOfContents.Format = wdIndexIndent
    End With

End Sub

我遇到的问题是，当我将合并结果保存为 PDF 时，一系列指向目录的超链接会中断。我发现的唯一解决方法是插入交叉引用，然后保存为 PDF。我想以编程方式执行此操作，例如在 for next 循环中，因为有相当多的实例需要插入前转换为 PDF。

理想情况下，我希望它执行以下操作：1. 找到文本“单击返回目录”2. 选择文本“目录”3. 插入交叉引用

我越来越接近了：

    Selection.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
        wdContentText, ReferenceItem:="TableofContents", InsertAsHyperlink:=True, _
         IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    Selection.HomeKey Unit:=wdLine

我如何让它找到下一个文本，然后循环遍历文档直到没有更多实例？

编辑替换似乎对我来说不起作用。

有想法吗？

提前致谢！

托马斯

答案1

因为你试图寻找一个文本，但要替换其中的一部分，你需要这样的东西：

Sub inserttocrefs()
Const FindText As String = "Click to Return to Table of Contents"
Const MarkText As String = "Table of Contents"
Dim markTextPosition As Integer
Dim r As Word.Range
markTextPosition = InStr(1, FindText, MarkText)
Set r = ActiveDocument.Content
With r.Find
  .ClearFormatting
  ' you may need other initialization stuff
  .Text = FindText
  .MatchCase = False ' or true if you need that
  .Forward = True
  .Wrap = wdFindStop
  While .Execute
    r.Start = r.Start + markTextPosition - 1
    r.End = r.Start + Len(MarkText) ' redundant in your example
    r.InsertCrossReference _
      referencetype:="Bookmark", _
      referencekind:=WdReferenceKind.wdContentText, _
      referenceitem:="TableofContents", _
      insertashyperlink:=True
    r.Collapse wdCollapseEnd
    r.End = ActiveDocument.Content.End
  Wend
End With
Set r = Nothing
End Sub

为了实现您的需要，书签“TableofContents”需要“覆盖”一段写着“目录”的文字

相关内容