In MS Word VBA, method to insert cross reference to the number of a numbered item using the number as it appears

Question

I have the following code to insert an updating, hyperlinked cross-reference in place of a user-typed plain text number referring to a previous list item:

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

I deal with documents with multiple numbered lists of different formatting, and the trouble is that if the user typed the number 5, the cross reference inserted will be to the 5th numbered item in the entire document, which may be a paragraph numbered "[0005]" instead of the user-intended list item numbered "5.", which appears much later in the document. I know it is possible to extract the list heading number as it appears for a given numbered item -- it is the ListString property of a ListFormat object; for example, Selection.Range.ListFormat.ListString will return the number as it appears for the selected paragraph.

But does this method have an inverse that will return a numbered item given its heading number as it appears, without having to explicitly iterate through paragraphs and extract the ListString property of each paragraph that is a ListFormat object until a match is found?

Answer 1

Update: I have created a full solution for doing this, though the output is only in alpha stage.

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

Assign the last sub on the page to Shift-Alt-F9 or somesuch,type 31(a),45 or somesuch, then press Shift-Alt-F9 twice (once to select the previous text, and once to convert it into references). I may develop it properly one day as a legal helper-app.

I believe all the concepts you need are contained in this demonstration.

It both iterates all numbered paragraphs, inserting a reference to each paragraph as it goes. It will probably break if there is a paragraph with less than 2 words, or insert multiple references -- this is just a starting point.

To generate a reference to specific and [complex] numbered paragraph such as 1(a)(i), you would iterate all numbered paragraphs until you found your matching paragraph. There is a ListLevel value you can use to build a complete "1(a)(i)" string as you iterate.

Once matched, it calls the second function which creates a reference based on the ListLevelNumber and joined words that comprise the paragraph -- that required some special trial and error work, and probably isn't perfect.

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

My solution uses a dictionaries to store the numbered items and reference numbers.

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

Not really clear on the original intent; however, I was automating inserting the cross references, and used dRef to get the reference item number for the Range.InsertCrossReference method:

Range.InsertCrossReference wdRefTypeNumberedItem, wdNumberFullContext, dRef(sKey), True, True, False, " ", where sKey was the text in the document that is replaced by the hyperlinked cross reference.