Jean-Guy
Fri Mar 11 14:19:33 CST 2005
Rui Mariano was telling us:
Rui Mariano nous racontait que :
> Hi,
>
> I need to split a Word 2003 doc in multiple docs with a predefined
> number of pages (eg, 10 pages). Therefore, all the docs created will
> have 10 pages (except the last maybe).
>
> One way is move through the pages of the original doc (starting from
> the beginning, iteratively until de end) creating docs and copying
> each block of 10 pages read.
Try this: (Note that this will work only with Word 2003 and that it does
not have any code for error handling...)
'_______________________________________
Option Explicit
'_______________________________________
Sub SplitBy10()
Dim UserRge As Range
Dim BlockRge As Range
Dim StartRge As Long
Dim EndRge As Long
Dim i As Long
Dim NewDoc As Document
Dim CurDocName As String
Dim CurDocPath As String
Dim NewDocSuffix1 As String
Dim NewDocSuffix2 As String
Dim NewDocName As String
Application.ScreenUpdating = False
Set UserRge = Selection.Range
Selection.HomeKey wdStory
With ActiveDocument
.Save
CurDocName = Left(.Name, Len(.Name) - 4)
CurDocPath = .Path
For i = 1 To ActiveWindow.ActivePane.Pages.Count / 10
If i = 1 Then
StartRge = .Range.Start
NewDocSuffix1 = "p" & i
Else
StartRge = Selection.Start
NewDocSuffix1 = "p" & ((i * 10) - 9)
End If
If i < ActiveWindow.ActivePane.Pages.Count / 10 Then
Selection.GoTo wdGoToPage, wdGoToAbsolute, (1 * (i * 10)) + 1
EndRge = Selection.Range.Characters.First.Start
NewDocSuffix2 = "p" & (i * 10)
Else
EndRge = .Range.End
NewDocSuffix2 = "p" & ActiveWindow.ActivePane.Pages.Count
End If
Set BlockRge = .Range(StartRge, EndRge).FormattedText
Set NewDoc = Documents.Add(Visible:=False)
NewDocName = CurDocName & "-" & NewDocSuffix1 & "-" & NewDocSuffix2
& ".doc"
With NewDoc
.Range.FormattedText = BlockRge
.SaveAs CurDocPath & Application.PathSeparator & NewDocName
.Close
End With
Next
End With
UserRge.Select
Application.ScreenRefresh
Application.ScreenUpdating = False
End Sub
'_______________________________________
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
jmarcilREMOVE@CAPSsympatico.caTHISTOO
Word MVP site:
http://www.word.mvps.org