Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 11-14-2017, 10:47 AM
chrscote chrscote is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2016
Posts: 4
chrscote is on a distinguished road
Exclamation Copying and pasting pages with changes

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
Reply With Quote
  #2  
Old 11-14-2017, 12:41 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,554
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

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.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 11-14-2017, 04:17 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,554
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

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
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #4  
Old 11-15-2017, 06:22 AM
chrscote chrscote is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2016
Posts: 4
chrscote is on a distinguished road
Default

I'm receiving an error when I run this code. On the first "Set Rng =" line of code, I get the error: "Object variable or With block variable not set". I copied and pasted the code exactly as it is in the code window, so I'm not sure what the issue is.
Quote:
Originally Posted by macropod View Post
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 = Rng.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
Reply With Quote
  #5  
Old 11-15-2017, 01:02 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,554
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Oops! Change:
Set Rng = Rng.GoTo(What:=wdGoToPage, Name:=i)
to:
Set Rng = .Range.GoTo(What:=wdGoToPage, Name:=i)
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #6  
Old 11-15-2017, 01:08 PM
chrscote chrscote is offline Windows 7 64bit Office 2010 64bit
Novice
 
Join Date: Aug 2016
Posts: 4
chrscote is on a distinguished road
Default

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.
Reply With Quote
  #7  
Old 11-15-2017, 01:22 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,554
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

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.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 08:31 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft