vbams-wordsuperscriptfootnotes

Word Macro - Superscripting all footnote numbers at the footnote-section at the bottom of the page


I'd like a macro in Office Word which superscripts all footnote numbers at the footnote-section at the bottom of the page.

Note: It's the footnote numbers at the bottom of the page I want superscripted, not the footnote numbers in the main text. See illustration below.

This post provides a seemingly key hint. But it's slightly off-topic. Sadly, I cannot reverse-engingeer this to work for me, nor does AI manage. Here's the helpful bit, from user Timothy Rylatt:

A Word document is constructed from a number of Story Ranges, one of which is the Footnotes Story. To make the footnote number non-superscript just in the footnotes you can execute a find and replace in the Footnotes Story as below.

Sub ApplyChicagoStyle()
   With ActiveDocument.StoryRanges(wdFootnotesStory).Find
      .Style = ActiveDocument.Styles(wdStyleFootnoteReference)
      .Replacement.Style = ActiveDocument.Styles(wdStyleFootnoteText)
      .Replacement.Font.Superscript = False
      .Format = True
      .Execute Replace:=wdReplaceAll
   End With
End Sub

Illustration of wrong format:

Main Text with in-text footnote numbers


1 [non-supercripted, at-bottom footnote number] footnote bottom-text

ChatGPT and CoPilot got pretty close. Below are their macros for inspiration. But both failed because they superscripted the footnote text at the bottom, and not the numbers themselves. However, these AI managed to write macros which correctly superscripted footnotes in the main text. Perhaps there is some different formatting in the footnote section at the bottom of the page, which throws them off?

ChatGPT:

Sub SuperscriptFootnoteNumbers()
    Dim footnote As Footnote
    Dim fnRange As Range
    
    ' Loop through each footnote in the document
    For Each footnote In ActiveDocument.Footnotes
        ' Get the range of the footnote's number (not the text)
        Set fnRange = footnote.Range
        
        ' Superscript the first character, which is the footnote number
        fnRange.Font.Superscript = True
    Next footnote
End Sub

CoPilot:

Sub SuperscriptFootnoteNumbersInText()
    Dim footnote As Footnote
    Dim rng As Range
    Dim i As Integer
    For Each footnote In ActiveDocument.Footnotes
        Set rng = footnote.Range.Paragraphs(1).Range
        i = 1
        Do While IsNumeric(Mid(rng.Text, i, 1))
            rng.Characters(i).Font.Superscript = True
            i = i + 1
        Loop
    Next footnote
End Sub

Solution

  • Simple as:

    Sub ApplySuperscriptToFootnoteReference()
    Application.ScreenUpdating = False
    Dim i As Long
    With ActiveDocument
      For i = 1 To .Footnotes.Count
        .Footnotes(i).Range.Paragraphs.First.Range.Words.First.Style = wdStyleFootnoteReference
      Next
    End With
    Application.ScreenUpdating = True
    End Sub
    

    If someone has messed with the Footnote Reference Style, either fix that or use:

        .Footnotes(i).Range.Paragraphs.First.Range.Words.First.Font.Superscript = True