批量创建Word书签及超链接自动化问题求助

原宏存在三个核心问题：直接操作Range对象修改了文档原始文本、字符串替换语法错误、未做书签重复检查。修复后的代码如下：

Sub CreateBoldBookmarks()
    Dim oRng As Range, oRngDup As Range
    Dim strBookmarkName As String, strOriginalText As String
    
    Set oRng = Selection.Range
    Set oRngDup = oRng.Duplicate
    
    With oRng.Find
        .ClearFormatting
        .Font.Bold = True
        .Wrap = wdFindStop ' 限制在初始选择范围内查找
        Do While .Execute
            ' 提取原始文本，不修改文档内容
            strOriginalText = oRng.Text
            ' 生成符合规则的书签名称
            strBookmarkName = Replace(strOriginalText, "/", "_")
            strBookmarkName = Replace(strBookmarkName, " ", "")
            strBookmarkName = "B" & strBookmarkName
            
            ' 避免重复创建书签报错
            If Not ActiveDocument.Bookmarks.Exists(strBookmarkName) Then
                If oRng.InRange(oRngDup) Then
                    ActiveDocument.Bookmarks.Add Name:=strBookmarkName, Range:=oRng
                Else
                    Exit Do
                End If
            End If
            
            ' 折叠范围，继续查找下一个粗体文本
            oRng.Collapse wdCollapseEnd
        Loop
    End With
End Sub

关键修正说明：

• 用字符串变量处理书签名称，完全不触碰文档原始内容
• 修正字符串替换语法，直接使用"/"和" "作为替换目标
• 添加书签存在性检查，避免重复创建报错
• 设置.Wrap = wdFindStop，防止超出初始选择范围后无限制查找

1. 匹配规则与正则表达式 #

需要匹配非粗体的1/02 07格式文本，但排除带前缀的情况（如A47G 1/02 07），可通过正则精准匹配：

• 独立文本匹配：^\d+/\d{2} \d{2}$（确保文本是单独的目标格式，无前缀）
• 段落内嵌入匹配：\b\d+/\d{2} \d{2}\b（匹配段落中单词边界内的目标格式）

2. VBA实现步骤 #

• 先在VBA编辑器中引用Microsoft VBScript Regular Expressions 5.5
• 遍历文档中非粗体文本，用正则筛选目标引用文本
• 对匹配到的文本，按书签规则生成对应名称，检查书签存在后创建超链接

示例代码框架：

Sub CreateHyperlinksToBookmarks()
    Dim oRng As Range
    Dim regEx As New RegExp
    Dim strBookmarkName As String, strMatchText As String
    
    ' 配置正则规则（以段落内嵌入匹配为例）
    With regEx
        .Pattern = "\b\d+/\d{2} \d{2}\b"
        .Global = False
        .IgnoreCase = False
    End With
    
    Set oRng = ActiveDocument.Content
    With oRng.Find
        .ClearFormatting
        .Font.Bold = False ' 只查找非粗体文本
        .Wrap = wdFindContinue
        Do While .Execute
            strMatchText = oRng.Text
            If regEx.Test(strMatchText) Then
                ' 生成对应书签名称
                strBookmarkName = Replace(strMatchText, "/", "_")
                strBookmarkName = Replace(strBookmarkName, " ", "")
                strBookmarkName = "B" & strBookmarkName
                
                ' 书签存在则创建超链接
                If ActiveDocument.Bookmarks.Exists(strBookmarkName) Then
                    ActiveDocument.Hyperlinks.Add Anchor:=oRng, Address:="", SubAddress:=strBookmarkName
                End If
            End If
            oRng.Collapse wdCollapseEnd
        Loop
    End With
End Sub

3. 特殊情况处理 #

• 若要排除特定前缀（如A47G ），可在正则中添加排除逻辑，或在匹配后检查文本前导字符是否为指定前缀
• 若格式有变体（如12/034 056），可调整正则为\b\d+/\d+ \d+\b

内容的提问来源于stack exchange，提问作者Nicolas Le Bihan