根据选择插入交叉引用的宏

J. *_*ick 2 vba ms-word

我目前为一家使用 set house-style 文档的公司工作。这包括我们 Word 模板中内置的多级编号标题。IE

  1. 标题 1

1.1 标题 2

1.1.1 标题 3

等等...

我们当前任务的很大一部分涉及添加对文档中其他部分的交叉引用。当文档运行到数百页,每页大约有 10 个引用时,这可能会非常耗时。

我想知道的是,是否可以设置一个宏来根据光标突出显示的内容添加 x-ref。即,如果您有一个句子,上面写着“请参阅第 3.2 条”,您可以突出显示“3.2”部分,运行宏并插入链接到标题 3.2 的外部参照。

不确定这是否可能,但将不胜感激任何建议。

Var*_*tus 6

这段代码将 - 有条件地 - 做你想做的事。

Sub InsertCrossRef()

    Dim RefList As Variant
    Dim LookUp As String
    Dim Ref As String
    Dim s As Integer, t As Integer
    Dim i As Integer

    On Error GoTo ErrExit
    With Selection.Range
        ' discard leading blank spaces
        Do While (Asc(.Text) = 32) And (.End > .Start)
            .MoveStart wdCharacter
        Loop
        ' discard trailing blank spaces, full stops and CRs
        Do While ((Asc(Right(.Text, 1)) = 46) Or _
                  (Asc(Right(.Text, 1)) = 32) Or _
                  (Asc(Right(.Text, 1)) = 11) Or _
                  (Asc(Right(.Text, 1)) = 13)) And _
                  (.End > .Start)
            .MoveEnd wdCharacter, -1
        Loop

ErrExit:
        If Len(.Text) = 0 Then
            MsgBox "Please select a reference.", _
                   vbExclamation, "Invalid selection"
            Exit Sub
        End If

        LookUp = .Text
    End With
    On Error GoTo 0

    With ActiveDocument
        ' Use WdRefTypeHeading to retrieve Headings
        RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
        For i = UBound(RefList) To 1 Step -1
            Ref = Trim(RefList(i))
            If InStr(1, Ref, LookUp, vbTextCompare) = 1 Then
                s = InStr(2, Ref, " ")
                t = InStr(2, Ref, Chr(9))
                If (s = 0) Or (t = 0) Then
                    s = IIf(s > 0, s, t)
                Else
                    s = IIf(s < t, s, t)
                End If
                If LookUp = Left(Ref, s - 1) Then Exit For
            End If
        Next i

        If i Then
            Selection.InsertCrossReference ReferenceType:="Numbered item", _
                                           ReferenceKind:=wdNumberFullContext, _
                                           ReferenceItem:=CStr(i), _
                                           InsertAsHyperlink:=True, _
                                           IncludePosition:=False, _
                                           SeparateNumbers:=False, _
                                           SeparatorString:=" "
        Else
            MsgBox "A cross reference to """ & LookUp & """ couldn't be set" & vbCr & _
                   "because a paragraph with that number couldn't" & vbCr & _
                   "be found in the document.", _
                   vbInformation, "Invalid cross reference"
        End If
    End With
End Sub
Run Code Online (Sandbox Code Playgroud)

以下是条件:-

  1. 文档中有“编号项目”和“标题”。你要求标题。我做了编号项目,因为我的电脑上没有那种样式。但是,在我的 PC 上,“标题”编号的项目。如果代码不能在你的文件上工作,交流wdRefTypeNumberedItemwdRefTypeHeading在代码中的标线。
  2. 我假设了一个编号格式,如“1”、“1.1”、“1.1.1”。如果你有什么不同,也许是“1”。“1.1.”、“1.1.1.”,代码需要调整。关键是代码将查找数字后面的空格或制表符。如果后面跟着句号、右括号或破折号,则它不起作用。另外,如果您碰巧选择了“1.2”。(最后一个句号)在文本中,代码将忽略句号并查找参考“1.2”。请注意,代码对选择中的偶然错误不敏感。它将删除任何前导或尾随空格以及意外包含的回车符或段落标记 - 和句号。

该代码将用它自己的(相同的)文本替换您所做的选择。这可能会导致现有格式发生变化。事实上,插入的参考字段从目标中获取文本。我不太清楚它适用哪种格式,目标的还是被替换的格式。我没有处理这个问题,如果有的话。

请查看代码插入的交叉引用的属性。你会看到这InsertAsHyperlink是真的。如果您愿意,可以将其设置为 False。IncludePosition是假的。如果将此属性设置为 True,您会看到“上方”​​或“下方”添加到代码替换的数字中。