View Single Post
 
Old 08-20-2021, 04:09 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,977
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Yep, that was a pretty big oversight on my behalf. Try this version - again, on a copy of your good document.
Code:
Sub RestrictXRefsSelection()
  Dim aFld As Field, aRngXRef As Range, sWord As String, aRngAnchor As Range, sBkmk As String
  Dim arrCode() As String, aRng As Range, aRngBk As Range
  Set aRng = Selection.Range
  For Each aFld In aRng.Fields
    If aFld.Type = wdFieldRef Then
      Set aRngXRef = aFld.Result
      sWord = LCase(Trim(aRngXRef.Words(1)))
      If sWord = "table" Or sWord = "figure" Then
        arrCode = Split(Trim(aFld.Code), " ")
        sBkmk = arrCode(1)
        If ActiveDocument.Bookmarks.Exists(sBkmk) Then
          Set aRngAnchor = ActiveDocument.Bookmarks(sBkmk).Range
          If InStr(LCase(aRngAnchor.Text), sWord) > 0 Then
            aRngAnchor.MoveStart Unit:=wdCharacter, Count:=Len(sWord) + 1
            ActiveDocument.Bookmarks.Add Name:=sBkmk, Range:=aRngAnchor
          End If
          aFld.Update
          aFld.Select
          If Trim(LCase(aRngXRef.Words.First.Previous.Text)) <> sWord Then
            Selection.Range.InsertBefore sWord & " ("
            Selection.Range.InsertAfter ")"
          End If
        End If
      End If
    End If
  Next aFld
  aRng.Select
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote