Say if you have the following text 1.2.5.1 and you want to add cross-reference it to a particular heading.
Here's a macro that will do this. Just place your cursor on the outline number and run the macro.
Sub ConvertNumberToReference()
' Edward Chan 2020
' Converts plain text outline number (e.g. 1.1.2) into a
' cross-reference to the corresponding heading number
a = Selection.MoveUntil(Cset:=Chr$(13) & "," & " ", Count:=wdBackward)
a = Selection.MoveEndUntil(Cset:=Chr$(13) & "," & " ", Count:=wdForward)
hnum = Selection.Text
hnum = CleanTrimA(hnum)
myHeadings = _
ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
For i = 1 To UBound(myHeadings)
rnum = CleanTrimA(myHeadings(i))
rnum = Trim(Left(rnum, InStr(rnum, " ")))
If StrComp(rnum, hnum, vbBinaryCompare) = 0 Then
Selection.InsertCrossReference _
ReferenceType:=wdRefTypeHeading, _
ReferenceKind:=wdNumberNoContext, ReferenceItem:=i, _
InsertAsHyperlink:=True
Selection.InsertAfter (" ")
Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertCrossReference _
ReferenceType:=wdRefTypeHeading, _
ReferenceKind:=wdContentText, ReferenceItem:=i, _
InsertAsHyperlink:=True
Exit For
End If
Next i
End Sub
Function CleanTrimA(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
Dim X As Long, CodesToClean As Variant
CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
For X = LBound(CodesToClean) To UBound(CodesToClean)
If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
Next
CleanTrimA = Trim(CleanString(S))
End Function
Here's another macro that is similar to the one above, but it looks for numbers in the format [2], which are commonly used for references.
Sub ConvertBracketedNumberToReferenceNumber()
' Edward Chan 2023
' Converts plain text number (e.g. [2]) into a
' cross-reference to the corresponding numbered item
a = Selection.MoveUntil(Cset:=Chr$(91), Count:=-3)
a = Selection.Move(Count:=-1)
a = Selection.MoveEndUntil(Cset:=Chr$(93), Count:=6)
a = Selection.MoveEnd(Count:=1)
hnum = Selection.Text
myNumberedItems = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)
For i = 1 To UBound(myNumberedItems)
rnum = myNumberedItems(i)
rnum = Trim(Left(rnum, InStr(rnum, " ")))
If StrComp(rnum, hnum, vbBinaryCompare) = 0 Then
Selection.InsertCrossReference _
ReferenceType:=wdRefTypeNumberedItem, _
ReferenceKind:=wdNumberNoContext, ReferenceItem:=i, _
InsertAsHyperlink:=True
Exit For
End If
Next i
End Sub