Consulting

Results 1 to 12 of 12

Thread: VBA to automatically mark cross-reference

  1. #1
    VBAX Newbie
    Joined
    Mar 2021
    Posts
    6
    Location

    VBA to automatically mark cross-reference

    I want to mark an entire Word document's cross-references with one click. The closest I've come to is this that marks just the selection and just level 1. It won't do subsections like 1.1(a) and it marks only the current selection. I'd like to ideally get a macro to mark all the cross references with the cross reference field in the whole document at once. Any ideas?

    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
    Last edited by disco; 03-02-2021 at 10:43 PM. Reason: Fix typo

  2. #2
    VBAX Contributor
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    118
    Location
    Just to clarify...
    You have a document where cross-references were typed manually to numbered paragraphs?
    The numbering was produced by Word automatically using a MultiLevel List?
    The numbered paragraphs are numbered using styles?
    You want to go through the entire document and change the manual cross-reference to a cross-reference field?

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    For example:
    Sub InsertAutoXRefs()
    Application.ScreenUpdating = False
    Dim Doc As Document, Para As Paragraph
    Dim ListNums As String, StrNum As String
    Dim i As Long, j As Long, x As Long
    Set Doc = ActiveDocument: ListNums = "|"
    With Doc
      For Each Para In .Paragraphs
        With Para.Range.ListFormat
          If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
        End With
      Next
      For i = 1 To UBound(Split(ListNums, "|")) - 1
        x = Len(Split(ListNums, "|")(i))
        If x > j Then j = x
      Next
      Do While j > 0
        For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
          StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
          If x = j Then
            ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
            Call MakeAutoXRefs(Doc, StrNum)
          End If
        Next
        j = j - 1
      Loop
    End With
    Application.ScreenUpdating = True
    End Sub
    
    
    Sub MakeAutoXRefs(Doc As Document, StrNum As String)
    Dim RefList As Variant, i As Long, j As Long
    With Doc
      RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
      For i = 1 To UBound(RefList)
        If Split(Trim(RefList(i)), " ")(0) = StrNum Then
        j = i: Exit For
        End If
      Next
      If j = 0 Then Exit Sub
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = " " & StrNum
          .Replacement.Text = ""
          .Format = False
          .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
        End With
        Do While .Find.Execute
          If .Fields.Count = 0 Then
            .Start = .Start + 1
            .InsertCrossReference ReferenceType:="Numbered item", _
              ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
              InsertAsHyperlink:=True, IncludePosition:=False, _
              SeparateNumbers:=False, SeparatorString:=" "
            .End = .End + 1
            .End = .Fields(1).Result.End
          End If
          .Collapse wdCollapseEnd
        Loop
      End With
    End With
    End Sub
    Last edited by macropod; 03-07-2021 at 06:53 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  4. #4
    VBAX Newbie
    Joined
    Mar 2021
    Posts
    6
    Location
    Chas: The numbered paragraphs were produced using MacPac which applied styles and I want it to go through the entire document and change the manual cross-reference to a cross-reference field? Does that make sense?

  5. #5
    VBAX Newbie
    Joined
    Mar 2021
    Posts
    6
    Location
    Macropod: I get a debugger error: StrNum = Split(ListNums, "|")(i)

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by disco View Post
    Macropod: I get a debugger error: StrNum = Split(ListNums, "|")(i)
    I don't get any such error. Moreover, I can't see how it's possible for the code to error-out there.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Regular
    Joined
    Jul 2012
    Posts
    29
    Location
    Hi Macropod

    The 1st line of code is red in the VBA Module? Why is that?

    Quote Originally Posted by macropod View Post
    For example:
    Sub InsertAutoXRefs()Application.ScreenUpdating = False     ****RED in vba module
    Dim Doc As Document, Para As Paragraph
    Dim ListNums As String, StrNum As String
    Dim i As Long, j As Long, x As Long
    Set Doc = ActiveDocument: ListNums = "|"
    With Doc
      For Each Para In .Paragraphs
        With Para.Range.ListFormat
          If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
        End With
      Next
      For i = 1 To UBound(Split(ListNums, "|")) - 1
        x = Len(Split(ListNums, "|")(i))
        If x > j Then j = x
      Next
      Do While j > 0
        For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
          StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
          If x = j Then
            ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
            Call MakeAutoXRefs(Doc, StrNum)
          End If
        Next
        j = j - 1
      Loop
    End With
    Application.ScreenUpdating = True
    End Sub
    
    
    Sub MakeAutoXRefs(Doc As Document, StrNum As String)
    Dim RefList As Variant, i As Long, j As Long
    With Doc
      RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
      For i = 1 To UBound(RefList)
        If Split(Trim(RefList(i)), " ")(0) = StrNum Then
        j = i: Exit For
        End If
      Next
      If j = 0 Then Exit Sub
      With .Range
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = " " & StrNum
          .Replacement.Text = ""
          .Format = False
          .Forward = True
          .Wrap = wdFindStop
          .MatchWildcards = True
        End With
        Do While .Find.Execute
          If .Fields.Count = 0 Then
            .Start = .Start + 1
            .InsertCrossReference ReferenceType:="Numbered item", _
              ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
              InsertAsHyperlink:=True, IncludePosition:=False, _
              SeparateNumbers:=False, SeparatorString:=" "
            .End = .End + 1
            .End = .Fields(1).Result.End
          End If
          .Collapse wdCollapseEnd
        Loop
      End With
    End With
    End Sub

  8. #8
    VBAX Regular
    Joined
    Jul 2012
    Posts
    29
    Location
    That just makes a mess in a Multilevel List with Levels 1-9. Am I missing something?



  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by jec1 View Post
    The 1st line of code is red in the VBA Module? Why is that?
    That's the result of a flaw in the forum software. As with any Sub, there should be a line break after the (). I've edited my post to rectify the correct formatting.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by jec1 View Post
    That just makes a mess in a Multilevel List with Levels 1-9.
    The code does nothing to any Multilevel List Level numbering. Perhaps you've converted yours to plain text - in which case they're no longer using Word's Multilevel List Level numbering and they're now just plain text. Even if that were so, though, the macro would still have no effect on them unless you'd also preceded them with a space character - in other words unless you've made a real dog's breakfast of the document...

    The only strings the macro might reasonably be expected to adversely affect are decimals that match existing Multilevel List Level numbers.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  11. #11
    VBAX Regular
    Joined
    Jul 2012
    Posts
    29
    Location

    Cross Reference entire document

    Macropod, I must be misunderstanding. If the document uses Multilevel list style autonumbering:

    1. Governing Law
    1.1 Sub Governing Law
    (a) Text is great at clause 2.
    (b) Text is better at clause 2.1(a).

    2. Legal Terms
    2.1 Definitions
    (a) Some text. In this clause refer to clause 1(b) please.
    (b) Some more text.

    I was assuming your code xref'd the references to "clause nnn". Sorry if I misunderstood.

    I have code (not perfect) but will run through up to 4 levels of cross references which was why I was interested.

    Thank you.

    Quote Originally Posted by macropod View Post
    The code does nothing to any Multilevel List Level numbering. Perhaps you've converted yours to plain text - in which case they're no longer using Word's Multilevel List Level numbering and they're now just plain text. Even if that were so, though, the macro would still have no effect on them unless you'd also preceded them with a space character - in other words unless you've made a real dog's breakfast of the document...

    The only strings the macro might reasonably be expected to adversely affect are decimals that match existing Multilevel List Level numbers.

  12. #12
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    The first consideration is whether you're using automatic or manual paragraph numbering. My code can only produce cross-references to paragraphs using automatic paragraph numbering, but has no effect whatsoever on the automatic paragraph numbering itself.


    If you have:
    • manual paragraph numbering, the code can't produce any cross-references;
    • a mix of both, all bets are off.


    One possible source of error in the code exists with numbering formats like (a), (b), etc. That can be resolved by changing:
    .MatchWildcards = True
    to:
    .MatchWildcards = False


    As for your specific examples:
    cross-references for 2.1(a) and 1(b) would not be found because there are no list strings in those formats.

    Moreover, from a coding standpoint, whether 1(b) refers to 1.1(b) or to 2.1(b) is indeterminate. The code I posted only works for automatically numbered paragraphs and cross-references that both employ fully-qualified list strings.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

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