根据节号表示的位置以编程方式生成书签

Question

我有一个 HTML 页面，其中包含链接，单击该链接可打开 Word 文档中的特定书签。 我正在处理一个现有的 Word 2003 文档，没有预先存在的书签。 我想使用宏或 VBA 脚本将书签添加到所有节号标题位置。 例子

3.1.4.2 这里
东西
3.1.4.2.1 又来了
更多内容
3.1.4.2.1.1 又来了
更多内容
3.1.4.2.2 又来了又来了
还有更多东西

我想为所有以 XXX 开头的行添加书签。 具有标准的名称格式。

示例（使用上面作为参考）

3.1.4.2 HERE 行将有一个名为 M_3_1_4_2 的书签
3.1.4.2.1 这里又会有一个名为 M_3_1_4_2_1

等

的书签。我的问题是我需要采取什么 VBA 脚本或宏方法才能实现这一点。

Answer 1

如果您已经有了范围对象，那么添加书签就很容易了。

ActiveDocument.Bookmarks.Add Name:=rngBookmark.Text, Range:=rngBookmark

确定范围通常是一项艰巨的任务。
现在你说这些是节标题。 它们是实际的单词节标题吗？ 它们是否以某种样式分隔？ 它们是在文档正文中还是页眉中？

您可以像这样循环浏览文档的各个部分，并将范围设置为该部分的开头。

Dim sectCurrent As Word.Section
Dim rngCurrent As Word.Range
For Each sectCurrent In ActiveDocument.Content.Sections

   ' get range that refers to the whole section
   Set rngCurrent = sectCurrent.Range.Duplicate

   ' collapse the range to the start of the section
   rngCurrent.Collapse wdCollapseStart

   ' expand the range to hold the first "word"
   ' you can also use other units here like wdLine
   rngCurrent.MoveEnd Unit:=wdWord, Count:=1

   ' now that you have the range you can add the bookmark
   ' you can process the range and create your own name with a custom function GenerateBookmarkName.  To get the string, just use rngCurrent.Text.
   ActiveDocument.Bookmarks.Add Name:=GenerateBookmarkName(rngCurrent), Range:=rngCurrent

Next sectCurrent

现在，如果它们不是实际的部分，您通常会希望使用 Find 对象在文档中查找某些内容并循环遍历所有此类项目。 这里的技巧是知道要搜索什么。 下面是一个循环示例。

   ' setup range object for search results
   Set rngFind = ActiveDocument.Content

   ' cycle through search results looking for whatever
   With rngFind.Find

      ' search text
      .Text = "FINDME"
      .Format = False
      .Wrap = wdFindStop

      ' loop while find is successfull
      Do While .Execute

         ' get range you can modify based on found item
         ' each time you call .Execute rngFind is changed to the found text
         Set rngModifyMe = rngFind.Duplicate    


      Loop

   End With   

如需更多 Word vba 帮助，您可以访问此处的 Word MVP 网站：http://word.mvps.org

Answer 2

    Public Sub HeadingsToBookmarks()
        Dim strText As String
        Dim heading As Range
        Dim hpara As Range
        Dim ln As Integer
        Set heading = ActiveDocument.Range(Start:=0, End:=0)
        Do
            Dim current As Long
            current = heading.Start
            Set heading = heading.GoTo(What:=wdGoToHeading, Which:=wdGoToNext)
            If heading.Start = current Then
                Exit Do
            End If
            Set hpara = heading.Paragraphs(1).Range
            strText = Trim(Left(hpara.Text, Len(hpara.Text) - 1))
            ln = Len(strText)
            If ln > 0 Then
                strText = Trim(RegExp_Replace(strText, "[0-9./-]*", ""))
                strText = Trim(RegExp_Replace(strText, " +", "_"))
                ActiveDocument.Bookmarks.Add Name:=strText, Range:=heading.Paragraphs(1).Range
            End If
        Loop
    End Sub
    Function RegExp_Replace(ReplaceIn, sPattern As String, ReplaceWith As String, Optional IgnoreCase As Boolean = False, _
        Optional GlobalMatch As Boolean = False, Optional bMultiLine As Boolean = False)
        Dim RE
        Set RE = CreateObject("vbscript.regexp")
        RE.Pattern = sPattern
        RE.IgnoreCase = True
        RE.Global = True
        RE.MultiLine = True
        RegExp_Replace = RE.Replace(ReplaceIn, ReplaceWith)
    End Function