Zum Kontrollieren der Diplomarbeit von Mareike wollte ich eine Übersicht der Fußnoten erstellen. Ich kann sie zwar von Word in Endnoten konvertieren lassen, damit sie dann kompakt am Ende des Dokumentes stehen, aber sobald ich sie dann in ein neues Dokument kopieren will, geht die Nummerierung der Fußnoten verloren.

Beim Word-FAQ habe ich dann die VBA-Funktion FussnotenverzeichnisErstellen() gefunden, die ein Verzeichnis der Fußnoten am Ende des Dokumentes erstellt.

Allerdings brauchte ich nicht zwingend die Seitenzahl der Fußnoten und hätte es auch gerne gleich in einem neuen Dokument gehabt. Also habe ich mir folgende VBA-Funktion geschrieben:

Sub FussnotenAufzaehlen()
  Dim oFootnotes As Footnotes, oFN As Footnote
  Dim oNewDoc As Document
  
  Set oFootnotes = ActiveDocument.Footnotes
  If (oFootnotes.Count > 0) Then 'Wenn Fußnoten vorhanden sind...
    Set oNewDoc = Application.Documents.Add
    
    For Each oFN In oFootnotes 'Für alle Fußnoten...
      oNewDoc.Range.InsertAfter oFN.Index
      oNewDoc.Paragraphs.Last.Range.Words(1).Style = wdStyleFootnoteReference
      oNewDoc.Range.InsertAfter vbTab
      oNewDoc.Range.InsertAfter oFN.Range
      oNewDoc.Range.InsertAfter vbCrLf
    Next oFN
  Else 'Wenn KEINE Fußnoten vorhanden sind...
    MsgBox "Das Dokument enthält keine Fußnoten."
  End If
End Sub

Leider gehen dabei die Formatierungen der Fußnoten verloren. Man kann also z. B. nicht mehr sehen, ob ein Herausgeben auch wirklich in Kapitälchen geschrieben wurde. Nach einigem Hin- und Her habe ich es aber mit folgender VBA-Funktion geschafft:

Sub FussnotenFormatiertAufzaehlen()
  Dim oFootnotes As Footnotes, oFN As Footnote
  Dim oNewDoc As Document, oRange As Range
  
  Set oFootnotes = ActiveDocument.Footnotes
  If (oFootnotes.Count > 0) Then 'Wenn Fußnoten vorhanden sind...
    Set oNewDoc = Application.Documents.Add
    
    For Each oFN In oFootnotes 'Für alle Fußnoten...
      Set oRange = oNewDoc.Paragraphs.Last.Range
      
      oRange.FormattedText = oFN.Range.FormattedText
      oRange.InsertBefore oFN.Index & vbTab
      oRange.Words(1).Style = wdStyleFootnoteReference
      oRange.InsertAfter vbCrLf
    Next oFN
  Else 'Wenn KEINE Fußnoten vorhanden sind...
    MsgBox "Das Dokument enthält keine Fußnoten."
  End If
End Sub

Vielleicht kann das jemand anderes ja auch mal gebrauchen… ;)