F
Fred
The macro posted works great.
'Sub MoveFootnotesToEnd() ' Works great
Dim i As Long
Dim Q As Long
Dim tbleFootNotes As Table
Dim rgeTbl As Range
Dim rgeRef As Range
If ActiveDocument.Footnotes.Count = 0 Then
Exit Sub
Else
Q = ActiveDocument.Footnotes.Count
End If
'Set up the table right away
Set rgeTbl = ActiveDocument.Range
With rgeTbl
.InsertParagraphAfter
.Collapse wdCollapseEnd
.Style = ActiveDocument.Styles(wdStyleFootnoteText)
.InsertAfter "MoveFootnotesToEnd"
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Set tbleFootNotes = rgeTbl.Tables.Add(Range:=rgeTbl, NumRows:=Q, _
NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed)
'Transfer and delete footnotes
i = 1
Do While ActiveDocument.Footnotes.Count > 0
With tbleFootNotes
.Cell(i, 1).Range.Text = "Footnote # " & i
.Cell(i, 2).Range.FormattedText =
ActiveDocument.Footnotes(1).Range.FormattedText
End With
Set rgeRef = ActiveDocument.Footnotes(1).Reference
ActiveDocument.Footnotes(1).Delete
ActiveDocument.Bookmarks.Add Range:=rgeRef, Name:="xxFootnote" & i
i = i + 1
Loop
End Sub
But how do I debug Reverse Macro to reinsert footnotes at bookmarks in my
document please, struggling beginner?
Sub MoveFootnotesToEndReverse()
'**Debug Error**' Q = Selection.Tables(1).Rows.Count - 1
ReDim FootnoteMark(Q) As String
ReDim FootnoteText(Q) As String
Selection.MoveRight Unit:=wdCell
For i = 1 To Q
Selection.MoveRight Unit:=wdCell
If AscW(Selection.Text) = 95 Or AscW(Selection.Text) = 13 Then
FootnoteMark(i) = ""
Else
FootnoteMark(i) = Selection.Text
End If
Selection.MoveRight Unit:=wdCell
FootnoteText(i) = Selection.Text
Next
Selection.Tables(1).Select
Selection.Tables(1).Delete
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
' Search for each bookmark that was created for a footnote
For i = 1 To Q
thisMark = "xxFootnote" & i
Selection.GoTo What:=wdGoToBookmark, Name:=thisMark
ActiveDocument.Bookmarks(thisMark).Delete
ActiveDocument.Footnotes.Add Range:=Selection.Range, _
Reference:=FootnoteMark(i), Text:=FootnoteText(i)
Next i
End Sub
'*********
'Sub MoveFootnotesToEnd() ' Works great
Dim i As Long
Dim Q As Long
Dim tbleFootNotes As Table
Dim rgeTbl As Range
Dim rgeRef As Range
If ActiveDocument.Footnotes.Count = 0 Then
Exit Sub
Else
Q = ActiveDocument.Footnotes.Count
End If
'Set up the table right away
Set rgeTbl = ActiveDocument.Range
With rgeTbl
.InsertParagraphAfter
.Collapse wdCollapseEnd
.Style = ActiveDocument.Styles(wdStyleFootnoteText)
.InsertAfter "MoveFootnotesToEnd"
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Set tbleFootNotes = rgeTbl.Tables.Add(Range:=rgeTbl, NumRows:=Q, _
NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed)
'Transfer and delete footnotes
i = 1
Do While ActiveDocument.Footnotes.Count > 0
With tbleFootNotes
.Cell(i, 1).Range.Text = "Footnote # " & i
.Cell(i, 2).Range.FormattedText =
ActiveDocument.Footnotes(1).Range.FormattedText
End With
Set rgeRef = ActiveDocument.Footnotes(1).Reference
ActiveDocument.Footnotes(1).Delete
ActiveDocument.Bookmarks.Add Range:=rgeRef, Name:="xxFootnote" & i
i = i + 1
Loop
End Sub
But how do I debug Reverse Macro to reinsert footnotes at bookmarks in my
document please, struggling beginner?
Sub MoveFootnotesToEndReverse()
'**Debug Error**' Q = Selection.Tables(1).Rows.Count - 1
ReDim FootnoteMark(Q) As String
ReDim FootnoteText(Q) As String
Selection.MoveRight Unit:=wdCell
For i = 1 To Q
Selection.MoveRight Unit:=wdCell
If AscW(Selection.Text) = 95 Or AscW(Selection.Text) = 13 Then
FootnoteMark(i) = ""
Else
FootnoteMark(i) = Selection.Text
End If
Selection.MoveRight Unit:=wdCell
FootnoteText(i) = Selection.Text
Next
Selection.Tables(1).Select
Selection.Tables(1).Delete
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
' Search for each bookmark that was created for a footnote
For i = 1 To Q
thisMark = "xxFootnote" & i
Selection.GoTo What:=wdGoToBookmark, Name:=thisMark
ActiveDocument.Bookmarks(thisMark).Delete
ActiveDocument.Footnotes.Add Range:=Selection.Range, _
Reference:=FootnoteMark(i), Text:=FootnoteText(i)
Next i
End Sub
'*********