Sub MoveFootnotes()

' Set of macros by Steven Marzuola - written June 2005
' written to more easily handle footnotes created in Microsoft Word 
' during translation using programs such as Déjà Vu.
' 
' Normally DV treats footnotes as sentence delimiters, which can be
' awkward if the notes are in the middle of complex sentences.
' This routine toggles the condition of footnotes. 

' When run the first time, it will move all footnotes to a table at 
' the end of the Word document, leaving a temporary placeholder 
' at the original location of each footnote marker.

' The second time, each footnote will be restored to its original location.

If MoveFootnotesToEndQuery Then
    MoveFootnotesToEndReverse
Else
    MoveFootnotesToEnd
End If

End Sub

' ==========================================================
' ==========================================================

Function MoveFootnotesToEndQuery() As Boolean

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "MoveFootnotesToEnd": .Replacement.Text = ""
        .Forward = True: .Wrap = wdFindContinue: .Format = False:
        .MatchCase = True: .MatchWholeWord = True: .MatchWildcards = False
        .MatchSoundsLike = False: .MatchAllWordForms = False
        .Execute
    End With

    MoveFootnotesToEndQuery = Selection.Find.Found

End Function

' ==========================================================
' ==========================================================

Sub MoveFootnotesToEnd()

' By Steven Marzuola - April 28, 2007
' Original suggestion by Rob Laumen
' Improved based on suggestion by Gary Daine:
' http://tech.groups.yahoo.com/group/help_/message/13161
'
' Created as a workaround to handle Word footnotes in programs such
' as Déjà Vu. DV treats footnotes as sentence delimiters, which can be
' problematic if the notes are in the middle of complex sentences.
'
' Improved version preserves formatting inside footnotes.
'
' MoveFootnotesToEnd is used before translation, to convert the footnotes
' so that they do not interrupt sentences when segmented in DV.
' After translation, use MoveFootnotesToEndReverse
'
' Moves all text found in the footnotes, to a table at the end of the document
'

Dim i As Long, Q As Long
Dim aVar As Variant

Q = ActiveDocument.Footnotes.Count

If Q = 0 Then
    Exit Sub
Else
    i = 0
    For Each aVar In ActiveDocument.Variables
        If aVar.Name = "FootnotesMovedToEnd" Then i = aVar.Index
    Next aVar
    If i = 0 Then
        ActiveDocument.Variables.Add Name:="FootnotesMovedToEnd", Value:=Q
    Else
        ActiveDocument.Variables(i).Value = Q
    End If

    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:="MoveFootnotesToEnd"
    Selection.TypeText Text:=vbTab

    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
        NumRows:=1, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading:= _
        True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
        ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
        AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCell, Count:=2
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="xxMarkerxx"

End If

i = 0
While ActiveDocument.Footnotes.Count > 0
    ActiveDocument.Footnotes(1).Range.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="xxMarkerxx"
    Selection.TypeText Text:=ActiveDocument.Footnotes(1).Reference.Text
    Selection.MoveRight Unit:=wdCell

    Selection.Paste

    Selection.Start = ActiveDocument.Footnotes(1).Reference.End - 1
    Selection.End = Selection.Start

    ActiveDocument.Footnotes(1).Delete
    i = i + 1
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="xxFootnote" & i
    If i < Q Then
        Selection.GoTo What:=wdGoToBookmark, Name:="xxMarkerxx"
        ActiveDocument.Bookmarks("xxMarkerxx").Delete
        Selection.MoveRight Unit:=wdCell, Count:=2
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="xxMarkerxx"
    End If
Wend

Selection.HomeKey Unit:=wdStory

With Selection.Find
    .ClearFormatting
    .Text = "MoveFootnotesToEnd": .Replacement.Text = "": .Forward = True
    .Wrap = wdFindContinue: .Format = False: .MatchCase = False
    .MatchWholeWord = False: .MatchWildcards = False
    .MatchSoundsLike = False: .MatchAllWordForms = False
    .Execute
End With

End Sub

' ==========================================================
' ==========================================================

Sub MoveFootnotesToEndReverse()

' Sub MoveFootnotesToEndReverse()
' by Steven Marzuola - April 28, 2007

' Used with MoveFootnotesToEnd

Dim i As Long, Q As Long, thisMark As String, FootnoteMark As String
Dim aVar As Variant, ViewSpecial, ViewType

ViewSpecial = ActiveWindow.View.SplitSpecial
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
    ViewType = ActiveWindow.ActivePane.View.Type
    ActiveWindow.ActivePane.View.Type = wdNormalView
Else
    ViewType = ActiveWindow.View.Type
    ActiveWindow.View.Type = wdNormalView
End If

i = 0
For Each aVar In ActiveDocument.Variables
    If aVar.Name = "FootnotesMovedToEnd" Then i = aVar.Index
Next aVar
If i = 0 Then
    MsgBox "No footnotes found", vbOKOnly
    Exit Sub
Else
    Q = ActiveDocument.Variables(i).Value
    ActiveDocument.Variables(i).Delete
End If

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
    .Text = "MoveFootnotesToEnd": .Replacement.Text = ""
    .Forward = True: .Wrap = wdFindContinue: .Format = False:
    .MatchCase = True: .MatchWholeWord = True: .MatchWildcards = False
    .MatchSoundsLike = False: .MatchAllWordForms = False
    .Execute
    If Not .Found Then
        MsgBox "No footnotes found", vbOKOnly
        Exit Sub
    End If
End With

    Selection.MoveRight Unit:=wdCell, Count:=2

For i = 1 To Q

    Selection.MoveRight Unit:=wdCell
    Selection.MoveLeft Unit:=wdCell

    FootnoteMark = Selection.Text
    If AscW(FootnoteMark) = 95 Or AscW(FootnoteMark) = 13 Then
        FootnoteMark = ""
    End If

    Selection.MoveRight Unit:=wdCharacter

    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="xxFootnoteRow"
    Selection.MoveRight Unit:=wdCell

    Selection.Cut

    thisMark = "xxFootnote" & i
    Selection.GoTo What:=wdGoToBookmark, Name:=thisMark
    ActiveDocument.Bookmarks(thisMark).Delete

    ActiveDocument.Footnotes.Add Range:=Selection.Range, Reference:=FootnoteMark
    Selection.Paste

    ActiveWindow.ActivePane.Close
    Selection.GoTo What:=wdGoToBookmark, Name:="xxFootnoteRow"
    Selection.EscapeKey
    Selection.Rows.Delete

Next i

Selection.HomeKey Unit:=wdStory

With Selection.Find
    .ClearFormatting: .Text = "MoveFootnotesToEnd": .Replacement.Text = ""
    .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = True
    .MatchWholeWord = True: .MatchWildcards = False
    .MatchSoundsLike = False: .MatchAllWordForms = False
    .Execute
End With

Selection.Tables(1).Select
Selection.Tables(1).Delete
Selection.Delete Unit:=wdCharacter, Count:=1

ViewSpecial = ActiveWindow.View.SplitSpecial
If ViewSpecial = wdPaneNone Then
    ActiveWindow.ActivePane.View.Type = ViewType
Else
    ActiveWindow.View.Type = ViewType
End If

End Sub