在 MS Word VBA 中，使用显示的数字插入对编号项目的编号的交叉引用的方法

Question

我有以下代码来插入更新的超链接交叉引用来代替用户输入的引用先前列表项的纯文本编号：

Selection.InsertCrossReference referencetype:="Numbered item", _
referencekind:=wdNumberNoContext, referenceitem:=<user-entered number>, 
InsertAsHyperlink:=True 

我处理具有不同格式的多个编号列表的文档，问题是如果用户键入数字 5，插入的交叉引用将是整个文档中的第 5 个编号项，这可能是编号为“[ 0005]”，而不是用户想要的编号为“5.”的列表项，它出现在文档的后面。我知道可以提取给定编号项目的列表标题编号——它是 ListFormat 对象的 ListString 属性；例如，

Selection.Range.ListFormat.ListString

将返回所选段落中显示的数字。

但是此方法是否有一个逆方法，即在给定标题编号的情况下返回一个编号项目，而无需显式迭代段落并提取每个段落（ListFormat 对象）的 ListString 属性，直到找到匹配项？

Answer 1

更新：我已经创建了一个完整的解决方案来执行此操作，尽管输出仅处于 alpha 阶段。

https://gist.github.com/sfinktah/789cfb36b3b15025d5796433da68ffb4

将页面上的最后一个子分配给 Shift-Alt-F9 或类似的名称，输入 31(a),45 或类似的名称，然后按 Shift-Alt-F9 两次（一次选择上一个文本，一次将其转换为引用） ）。有一天我可能会正确地开发它作为一个法律助手应用程序。

我相信你需要的所有概念都包含在这个演示中。

它都会迭代所有编号的段落，并在每个段落运行时插入对每个段落的引用。如果段落少于 2 个单词，或者插入多个引用，它可能会中断 - 这只是一个起点。

要生成对特定且[复杂]编号的段落（例如 1(a)(i)）的引用，您需要迭代所有编号的段落，直到找到匹配的段落。您可以使用一个 ListLevel 值在迭代时构建完整的“1(a)(i)”字符串。

一旦匹配，它就会调用第二个函数，该函数根据 ListLevelNumber 和构成该段落的连接单词创建引用 - 这需要一些特殊的试错工作，并且可能并不完美。

Public Sub InsertParagraphReference(ByRef doc As word.Document, _
                                    ByRef sel As word.Selection, _
                                    match As String)
    myHeadings = _
        doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
    Dim count As Integer
    count = 0
    For i = 1 To UBound(myHeadings)
        If InStr(LTrim(myHeadings(i)), match) = 1 Then
            count = count + 1
            With sel
                .Collapse Direction:=wdCollapseStart
                .InsertBefore "paragraph "
                .Collapse Direction:=wdCollapseEnd
                .InsertCrossReference _
                    ReferenceType:=wdRefTypeNumberedItem, _
                    ReferenceKind:=wdNumberFullContext, ReferenceItem:=i, _
                    InsertAsHyperlink:=True, IncludePosition:=True
                .InsertAfter ", "
                ' Be careful of inserting newlines, as endless loops can occur
                ' if you are making a new list-item each time.
                ' vbCr
                .Collapse Direction:=wdCollapseEnd
            End With
        End If
    Next i
    If count = 0 Then
        With sel
            .Collapse Direction:=wdCollapseStart
            .InsertBefore "failed_match: '" & match & "'"
            .Collapse Direction:=wdCollapseEnd
            .InsertParagraphAfter
        End With
    End If
End Sub

Public Function JoinWords(ByRef words As Variant) As String
    Dim joined As String
    Dim count As Integer
    count = 0
    For Each aWord In words
        aWord = FilterWord(aWord)
        If Len(aWord) > 0 Then
            If aWord.Characters(1) > Chr(31) Then
                joined = joined + aWord
                count = count + 1
            End If
        End If
        If count > 10 Then Exit For
    Next aWord
    JoinWords = joined
End Function

Public Function FilterWord(ByRef word As Variant) As String
    Dim filtered As String
    Dim ord As Integer
    filtered = ""
    Dim length As Integer
    length = Len(word)
    For i = 1 To length
        ord = Asc(word.Characters(i))
        If ord > 31 Then filtered = filtered + Char
        If ord = 11 Then filtered = filtered + " "
    Next i
    FilterWord = filtered
End Function
    
Sub IterateNumberedParagraphsAndReference()
    Dim para As Paragraph
    Dim joined As String
    ' .ListParagraphs iterates in reverse order, so use .Paragraph and filter
    For Each para In ActiveDocument.Paragraphs
        With para.Range
            If .ListParagraphs.count > 0 Then
                joined = JoinWords(.words)
                If 0 Then
                    MsgBox "Style: " & para.Style _
                        & " OutlineLevel: " & para.OutlineLevel _
                        & " ListLevel: " & .ListFormat.ListLevelNumber _
                        & " Text: " & .ListFormat.ListString & " " _
                            & "'" & RTrim(joined) & "'"
                End If
                InsertParagraphReference ActiveDocument, Selection, _
                .ListFormat.ListString & " " & RTrim(joined)
                
             End If
        End With
    Next para
End Sub

Answer 2

我的解决方案使用字典来存储编号项目和参考编号。

Function ReadNbrs() As Variant
    Dim vList, vItem, vSplit, vReturn
    Dim dRefText As Object
    Dim dRefNbr As Object
    Dim dRef as Object

    'return text given nbr
    Set dRefText = CreateObject("Scripting.Dictionary")

    'return nbr given text
    Set dRefNbr = CreateObject("Scripting.Dictionary")

    'return reference item number
    Set dRef = CreateObject("Scripting.Dictionary")

    vList = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

    For Each vItem in vList
        'delimiter depends on your lists ... space, tab, other?
        vSplit = Split(vItem, vbTab)
        dRefNbr(vSplit(1)) = vSplit(0)
        dRefText(vSplit(0)) = vSplit(1)
        dRef(vSplit(0)) = dRef.Count + 1
    Next vItem

    vReturn = Array(dRef, dRefNbr, dRefText)
    ReadNbrs = vReturn

Exit Function

不太清楚初衷；但是，我正在自动插入交叉引用，并使用 dRef 来获取

Range.InsertCrossReference

方法的参考项编号：

Range.InsertCrossReference wdRefTypeNumberedItem, wdNumberFullContext, dRef(sKey), True, True, False, " "

，其中 sKey 是文档中被超链接交叉引用替换的文本。