Microsoft Office Forums - View Single Post - [Solved] VBA Move Footnote References Before Punctuation

macropod · 08-17-2022, 04:00 PM

In your sample document, you have a formfield immediately after the first footnote reference. The code was not written with such documents in mind. As written, the code moves each character after the footnote reference individually, which is obviously not possible the formfields. For your document, the code needed to be completely re-written to process all the references in reverse order and move the actual references instead of the associated text:

Code:

Sub FootnotePunctBefore()
Application.ScreenUpdating = False
Dim bHid As Boolean, i As Long, Rng As Range, StrBkMkNm As String
With ActiveDocument
  bHid = .Bookmarks.ShowHidden
  .Bookmarks.ShowHidden = True
  For i = .Footnotes.Count To 1 Step -1
    With .Footnotes(i)
      With .Reference
        Set Rng = .Duplicate
        If .Bookmarks.Count = 0 Then
          StrBkMkNm = ""
        Else
          StrBkMkNm = .Bookmarks(1).Name
        End If
      End With
      With Rng
        .Collapse wdCollapseStart
        'Eliminate any spaces before the footnote reference
        Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
          .Characters.First.Previous.Text = vbNullString
        Loop
        'Find the preceding puctuation, bracket, etc.
        Do While .Characters.First.Previous Like "[!0-9A-Za-z" & vbCr & Chr(11) & vbTab & "]"
          If .Characters.First.Previous.Fields.Count = 1 Then Exit Do
          If .Characters.First.Previous.ContentControls.Count = 1 Then Exit Do
          .End = .End - 1
        Loop
      End With
      'Swap the footnote/punctuation, as applicable
      If .Reference.Start <> Rng.Start Then
        Rng.FormattedText = .Reference.FormattedText
        If StrBkMkNm <> "" Then .Range.Bookmarks.Add StrBkMkNm, Rng
        .Delete
      End If
    End With
  Next
  For i = .Range.Fields.Count To 1 Step -1
    With .Range.Fields(i)
      If .Type = wdFieldNoteRef Then
        Set Rng = .Result
        With Rng
          .Collapse wdCollapseStart
          'Eliminate any spaces before the footnote reference
          Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
            .Characters.First.Previous.Text = vbNullString
          Loop
          'Find the preceding puctuation, bracket, etc.
          Do While .Characters.First.Previous Like "[!0-9A-Za-z" & vbCr & Chr(11) & vbTab & "]"
            If .Characters.First.Previous.Fields.Count = 1 Then Exit Do
            If .Characters.First.Previous.ContentControls.Count = 1 Then Exit Do
            .End = .End - 1
          Loop
        End With
        'Swap the footnote/punctuation, as applicable
        If .Result.Start <> Rng.Start Then
          Rng.FormattedText = .Result.FormattedText
          .Delete
        End If
      End If
    End With
  Next
  .Bookmarks.ShowHidden = bHid
End With
Application.ScreenUpdating = True
End Sub