View Single Post
 
Old 01-26-2012, 03:39 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,365
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Ken,

On a PC, if you access a footnote or endnote range and press Ctrl-A, that selectes all the footnotes or endnotes in the document. You can then use the normal copy/paste commands to replicate them in a new document. The only 'issues' with this are that:
a) you can't delete footnotes or endnotes from the original document this way; and
b) the paste footnotes or endnotes all end up numbered 1 in the new document.
A macro can easily enough address both issues:
Code:
Sub ExtractEndNotes()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long, Doc As Document
With ActiveDocument
  If .Endnotes.Count = 0 Then Exit Sub
  For i = 1 To .Endnotes.Count
    Set Rng = .Endnotes(i).Reference
    With Rng
      .Collapse wdCollapseEnd
      .Text = i
      .Style = "Endnote Reference"
    End With
  Next
  .StoryRanges(wdEndnotesStory).Copy
  For i = .Endnotes.Count To 1 Step -1
  .Endnotes(i).Delete
  Next
End With
Set Doc = Documents.Add
With Doc.Range
  .Paste
  With .Find
    .ClearFormatting
    .Text = ""
    .Style = "Endnote Reference"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    .Text = i
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Characters.Last.Delete
End With
Set Rng = Nothing: Set Doc = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote