Help: Merging pages from 2 documents.

[Luca Brigatti]

I scanned a texbook and I now have 2 word documents, one contains the Odd
pages in increasing order (1, 3, 5, 7, 9....), the other contains the Even
pages in decreasing order (540, 538, 536, 534, 532 ....).

I want to write a VBA program to merge the two documents in an unique
document, somehing like this in pseudocode:

For x=1 to 540
Copy page x from Odd document and Paste it in New document: ' Start with
first page
Copy page (541 - x) from Even document and Paste it in New document: '
Start with last page (real page 2)
Next x

I know it should be possible but although I have some familiarity fith VB6 I
have never programmed in VBA.

Any help greatly appreciated.

Thanks


Luca

 

[Doug Robbins - Word MVP]

Hi Luca,

I developed the following code for some one who wanted to create single
document when all of the odd pages were in one file and the even ones were
in another. It should do what you need:

Dim sourcea As Document, sourceb As Document, target As Document, Pages
As Integer, Counter As Integer, targetrange as Range 'targetrange added

Set sourcea = Documents.Open(FileName:="...")
sourcea.Repaginate
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
MsgBox Pages
Set sourceb = Documents.Open(FileName:="...")
Set target = Documents.Add
target.PageSetup.LeftMargin = sourcea.PageSetup.LeftMargin
target.PageSetup.RightMargin = sourcea.PageSetup.RightMargin
target.PageSetup.TopMargin = sourcea.PageSetup.TopMargin
target.PageSetup.BottomMargin = sourcea.PageSetup.BottomMargin
target.AcceptAllRevisions
Counter = 0
While Counter < Pages
sourcea.Activate
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste
ActiveDocument.Bookmarks("\page").Range.Cut
sourceb.Activate
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste
ActiveDocument.Bookmarks("\page").Range.Cut
Counter = Counter + 1
Wend
sourcea.Close wdDoNotSaveChanges
sourceb.Close wdDoNotSaveChanges

Please respond to the newsgroups for the benefit of others who may be
interested.

Hope this helps
Doug Robbins - Word MVP

 

[Luca Brigatti]

Thank you for the quick answer.
I'll give it a try!

Luca

 

[Luca Brigatti]

Thanks Doug, although I don't understand it fully, it works very well!

I made a little modification to avoid a runtime error when sourceb is
shorter than sourcea (I'll be happy to send it to you if you like although
it is quite trivial).

The next problem I have is that the document containing the even page has
the last page first: (540, 538, 536, 534, 532 etc). That's because I simply
flip the bundle of pages upside down after scanning the odd pages and rescan
the even pages that way.

Do you think it would be possible to write a short separate code to flip the
document, perhaps by copying each page to a new document starting from the
last one?

Thanks again for your help

Luca

 

[Doug Robbins - Word MVP]

Hi Luca,

Try this:

Dim sourcea As Document, sourceb As Document, target As Document, Pages
As Integer, Counter As Integer, targetrange As Range 'targetrange added

Set sourcea = Documents.Open(FileName:="...")
sourcea.Repaginate
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
MsgBox Pages
Set sourceb = Documents.Open(FileName:="...")
Set target = Documents.Add
target.PageSetup.LeftMargin = sourcea.PageSetup.LeftMargin
target.PageSetup.RightMargin = sourcea.PageSetup.RightMargin
target.PageSetup.TopMargin = sourcea.PageSetup.TopMargin
target.PageSetup.BottomMargin = sourcea.PageSetup.BottomMargin
target.AcceptAllRevisions
Counter = 0
While Counter < Pages
sourcea.Activate
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste
ActiveDocument.Bookmarks("\page").Range.Cut
sourceb.Activate 'Assumed to be the document containing the even
pages
Selection.EndKey Unit:=wdStory 'Line of code added to start from the
end of the document
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste
ActiveDocument.Bookmarks("\page").Range.Cut
Counter = Counter + 1
Wend
sourcea.Close wdDoNotSaveChanges
sourceb.Close wdDoNotSaveChanges

As you will note from the comment included in the code, I have assumed that
the document opened as sourceb is the one that contains the even pages and a
line of code has been added to move the selection to the end of that
document each time.

It might be best to add a few empty pages at the appropriate place
(beginning or end) to sourceb so that both documents have the same number of
pages

--
Please respond to the newsgroups for the benefit of others who may be
interested.

Hope this helps
Doug Robbins - Word MVP

 

[Luca Brigatti]

After a few exchanges off line, Doug Robbins sent me a program that does
exactly what I need (merges two documents in which the first contains the
Odd pages in ascending order and the second the even pages in descending
order).

Here it is with just a couple of minor modifications from me:

Thanks doug

Luca

----------------------

Sub MergeNew()

Dim sourcea As Document, sourceb As Document, target As Document
Dim Pages As Integer, Counter As Integer, targetrange As Range 'targetrange
added
Dim x As Integer
Dim evenpage As Range


Set sourcea = Documents.Open(FileName:="Odds.doc")
sourcea.Repaginate
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
MsgBox Pages
Set sourceb = Documents.Open(FileName:="Evens.doc")
Set target = Documents.Add
target.PageSetup.LeftMargin = sourcea.PageSetup.LeftMargin
target.PageSetup.RightMargin = sourcea.PageSetup.RightMargin
target.PageSetup.TopMargin = sourcea.PageSetup.TopMargin
target.PageSetup.BottomMargin = sourcea.PageSetup.BottomMargin
target.AcceptAllRevisions
Counter = 0

' Main copy-paste routine

While Counter < Pages
sourcea.Activate
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste

' Places a line break after the last Odd page only
If Pages - Counter = 1 Then
targetrange.Start = targetrange.End
targetrange.InsertBreak Type:=wdPageBreak
End If

ActiveDocument.Bookmarks("\page").Range.Cut

sourceb.Activate 'Assumed to be the document containing the even
Pages
Selection.EndKey Unit:=wdStory 'Line of code added to start from the
end of the document
ActiveDocument.Bookmarks("\page").Range.Copy
Set targetrange = target.Range
targetrange.Start = targetrange.End
targetrange.Paste

' Places a line break after any Even page
targetrange.Start = targetrange.End
targetrange.InsertBreak Type:=wdPageBreak


' Eliminates leftovers from last even page
Set evenpage = ActiveDocument.Bookmarks("\page").Range
evenpage.Start = evenpage.Start - 1
evenpage.Delete


Counter = Counter + 1
Wend

sourcea.Close wdDoNotSaveChanges
sourceb.Close wdDoNotSaveChanges



End Sub

-----------------------------------------------------------