Results 1 to 2 of 2

Thread: Automatic Cross-Referencing

  1. #1
    VBAX Newbie
    Mar 2021
    I have multiple headings in a document as a scheme that goes like this: heading 1 is Section 1, heading 2 is 1.1, and heading 3 is 1.1(a). Throughout the document, there are references like, please see Section 2.2(c). Instead of going into the insert cross reference each time and find the heading and select it to make a hyperlinked cross reference, I want to do it automatically. I would like it to do the whole document at once, but so far I can only make a code that does it one by one and you have to select it first. It also doesn't pick up anything with a letter, so it won't catch 2.2(c).

    Do you know how to fix this so it does the letter subheadings as well?

    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
    ' 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
    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)
    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:=" "
    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
    Last edited by macropod; 04-06-2021 at 01:51 PM. Reason: New topic split from existing thread

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Jul 2008
    We discussed this previously in VBA to automatically mark cross-reference ( Please continue the discussion there. Thread closed.
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts