使用 VBA 在 Microsoft Word 中快速参考

Question

我在 MS Word 中编写了两个模块，可以提高为两个相互引用的单词创建超链接的速度：

当我们想要引用很多单词时，这特别有用。但我的模块有一个缺点。当我有很多话的时候，有些话可能是重复的。换句话说，我在第 1 页中引用了“书”和第 2 页中的“男孩”这两个词，现在我想在第 10 页中引用“书”和“纸”这两个词。对于我的模块，这是不可能的，因为一本书和一本书都有一个书签。有办法二解决这个问题吗？或者有人有想法吗？

这些是我的模块：

        Public N1 As String 
         Public N2 As String 
        Public Name2 As String 
        Public R2 As Range 
    Sub Macro1()
        N2 = Selection.Text
        Set R2 = Selection.Range
        Name2 = Trim(N2)
        N2 = Name2
        Name2 = Name2 & "a"
        With ActiveDocument.Bookmarks
            .Add Range:=Selection.Range, Name:=Name2
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
        With Selection.Range
            Selection.Font.Color = 16724787
            Selection.Font.UnderlineColor = wdColorAutomatic
            Selection.Font.Underline = wdUnderlineSingle
        End With 
        End Sub
    
    Sub Macro2()
        N1 = Selection.Text
        Dim Name1 As String
        Name1 = Trim(N1)
        N1 = Name1
        Name1 = Name1 & "b"
        With ActiveDocument.Bookmarks
            .Add Range:=Selection.Range, Name:=Name1
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
        With Selection.Range
            Selection.Font.Color = 16724787
            Selection.Font.UnderlineColor = wdColorAutomatic
            Selection.Font.Underline = wdUnderlineSingle
        End With
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
            SubAddress:=Name2, ScreenTip:="", TextToDisplay:=N1
        ActiveDocument.Hyperlinks.Add Anchor:=R2, Address:="", _
            SubAddress:=Name1, ScreenTip:="", TextToDisplay:=N2 
        End Sub

Answer 1

使用字典来管理标记名称。以下函数将返回带有数字后缀的书签名称。该字典对于函数来说是本地的，但如果需要，可以在模块级别轻松声明。

返回名称中的“_”可以通过在“_”处拆分来轻松检索词干名称。

Public Function GetBookMarkName(byref ipName as string) as String

    Static mBookmarks as Scripting.Dictionary
    If mBookmarks is nothing then 
        Set mBookmarks = new scripting.dicitonary
    end if

    if mBookmarks.Exists(myName) then
       mBookmarks.Item(name) = mBookmarks.name+1
    else
       mBookmarks.add myName,1
    end if
    
     GetBookmarkName = ipName & "_" & cstr(mBookmarks.Item(ipName))

end function