Word - combinar paginas pares e impares

Sub Dividirdocumentos()

' Divide un documento extenso en varios bloques

Dim iSplit As Long, iCount As Long, iLast As Long

Dim RngSplit As Range, StrDocName As String, StrDocExt As String

With ActiveDocument

iSplit = InputBox("El documento contiene " & .ComputeStatistics(wdStatisticPages) & " páginas." _

& vbCr & "¿Cuál es el número de páginas por el que quiere dividir?", "DividirDocumentos")

StrDocName = .FullName

StrDocExt = "." & Split(StrDocName, ".")(UBound(Split(StrDocName, ".")))

StrDocName = Left(StrDocName, Len(StrDocName) - Len(StrDocExt)) & "_"

For iCount = 0 To Int(.ComputeStatistics(wdStatisticPages) / iSplit)

If .ComputeStatistics(wdStatisticPages) > iSplit Then

iLast = iSplit

Else

iLast = .ComputeStatistics(wdStatisticPages)

End If

Set RngSplit = .GoTo(What:=wdGoToPage, Name:=iLast)

Set RngSplit = RngSplit.GoTo(What:=wdGoToBookmark, Name:="\page")

RngSplit.Start = .Range.Start

RngSplit.Cut     ='/img/emoticons/wink.gif' width='22' height='22' border='0' />aqui me da el error='/img/emoticons/confused.gif' width='22' height='22' border='0' />

Documents.Add

Selection.Paste

ActiveDocument.SaveAs FileName:=StrDocName & iCount + 1 & StrDocExt, AddToRecentFiles:=False

ActiveWindow.Close

Next iCount

Set RngSplit = Nothing

'.Close Savechanges:=False

End With

End Sub

Sub mergeDocuments ()

Dim sourcea As Document, sourceb As Document, target As Document, Pages

As Integer, Counter As Integer, targetrange As Range 'targetrange added

Dim evenpage As Range

Set sourcea = Documents.Open(FileName:="...")

sourcea.Repaginate

Pages = ActiveDocument.BuiltInDocumentProperties(wdPropert yPages)

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

targetrange.Start = targetrange.End

targetrange.InsertBreak Type:=wdPageBreak

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