Microsoft Office Forums - View Single Post - [Solved] Extract all footnotes and add them to a customized table

gmaxey · 07-19-2022, 06:19 AM

I was working on this before I had to leave for a short trip yesterday. Was thinking along the same lines as Paul - and not that it makes a big difference - but was wanting to avoid the two loops. Here is my version:

Code:

Sub ListFootnotes()
Dim oDoc As Document, oDocTbl As Document
Dim oTbl As Table
Dim oRng As Range
Dim lngIndex As Long
  Application.ScreenUpdating = False
  Set oDoc = ActiveDocument: Set oDocTbl = Documents.Add
   With oDocTbl
    Set oTbl = .Tables.Add(Range:=.Range, Numrows:=3, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior)
    oTbl.Columns(1).Cells.Merge
    Set oRng = oTbl.Range.Duplicate
     For lngIndex = 1 To oDoc.Footnotes.Count
      With oTbl
        .Cell(.Range.Information(wdEndOfRangeRowNumber) - 2, 1).Range.Text = lngIndex
        .Cell(.Range.Information(wdEndOfRangeRowNumber) - 2, 2).Range.Text = "Original:" & vbCr & oDoc.Footnotes(lngIndex).Range.FormattedText
        .Cell(.Range.Information(wdEndOfRangeRowNumber) - 1, 2).Range.Text = "Copy 1:" & vbCr & oDoc.Footnotes(lngIndex).Range.FormattedText
        .Cell(.Range.Information(wdEndOfRangeRowNumber), 2).Range.Text = "Copy 2:" & vbCr & oDoc.Footnotes(lngIndex).Range.FormattedText
      End With
      If lngIndex < oDoc.Footnotes.Count Then .Range.Characters.Last.FormattedText = oRng.FormattedText
    Next
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub