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
(e-mail address removed)
Word MVP site:
http://www.word.mvps.org