Copying and pasting pages with changes

chrscote · #1 11-14-2017, 10:47 AM

I have a document which has Track Changes turned on. I want to select any pages that have a revision made to it and copy it to a 2nd document. I would also like to, if possible, include the footer contents of the page I'm copying. The first part is giving me problems, however. Here is the code I'm using:

Code:

For Each oRevision In oDoc.Revisions







        revNum = revNum + 1
        'If this page hasn't already been copied (for multiple revisions on single page)
        If oRevision.Range.Information(wdActiveEndPageNumber) <> nLastPageNum Then
            'Also check that the change is not in the header or footer
            If oRevision.Range.StoryType = wdMainTextStory Then
                MsgBox (oRevision.Range.Text)
                'Add 1 to counter
                n = n + 1
                oDoc.Activate
                ActiveDocument.Bookmarks("\Page").Select
                Selection.Copy
                oNewDoc.Activate
                Selection.EndKey wdStory
                Selection.InsertBreak (wdPageBreak)
                Selection.PasteAndFormat wdPasteDefault
                nLastPageNum = oRevision.Range.Information(wdActiveEndPageNumber)
            End If
        End If
    Next oRevision

Unfortunately, rather than select the page that contains the change in oDoc, the code selects the contents of the first page each time through the loop. I would appreciate any help I can get on this little dilemma. I'm sure that the 2nd half of my loop is OK, I just need to figure out the correct steps to be able to copy the appropriate page.

Chris

macropod · #2 11-14-2017, 12:41 PM

Try something along the lines of:

Code:

Sub Demo()
Dim DocSrc As Document, DocTgt As Document, i As Long, Rng As Range
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocSrc
  For i = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    If Rng.Revisions.Count > 0 Then
      With DocTgt.Range
        .InsertAfter Chr(12)
        .Characters.Last.FormattedText = Rng.FormattedText
      End With
    End If
  Next
End With
End Sub

As for headers & footers, you won't be able to get those reliably unless you insert Next Page Section breaks in the output document and unlink the new Sections' headers & footers from the previous one, clear their contents then replicate your existing page's header/footer. And, if there are fields in those headers/footers that include page counts, etc., you'll have to either accept them displaying the wrong values or edit them to display the right ones - in which case they're no longer an accurate copy of the original. Either way, replicating header/footer content is a lot more work than just the above code's insertion of page breaks.

macropod · #3 11-14-2017, 04:17 PM

Cross-posted at: http://www.vbaexpress.com/forum/show...ent-to-new-one
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

chrscote · #4 11-15-2017, 01:08 PM

Thank you! It works like a charm now with one issue that I already found out about that when I paste into the new document, the section numbers change. I need to figure out if there's a way to keep the section numbers from the original document.

macropod · #5 11-15-2017, 01:22 PM

That is one of the limitations you encounter when copying parts of one document to another. An alternative approach that might work better for you is to make a copy of the document then delete pages that have no changes (keeping Section breaks intact). That will also mean you automatically get the original header/footer content with no additional code.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copying, Cutting and pasting	Steve0513	Excel	1	07-13-2017 05:09 PM
copying and pasting text format	paik1002	Excel	2	10-07-2016 02:34 AM
Prevent Copying and Pasting	Jimmy Tsawo	Excel	3	02-20-2014 03:54 AM
Copying and pasting from Excel	Lorna B	Word	1	03-20-2012 11:58 PM
Copying & Pasting to Firefox problems	mso2u	Word	2	04-07-2011 07:26 AM