1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
|
Sub SplitDocument()
Dim i As Integer
Dim flag As Boolean
Dim intLastPage As Integer
Dim strPrevBM As String
Dim strNextBM As String
Dim objDocument As Document
Dim intPageCount As Integer
Dim intCurrentPage As Integer
Dim strPath As String
Dim intIndex As Integer
Dim intResult As Integer
intPageCount = 5
flag = True
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strPath = Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1)
'You can change this
ThisDocument.Activate
'get last page number
intLastPage = Range.Information(wdActiveEndPageNumber)
'move to the start of the document
Selection.HomeKey Unit:=wdStory
'create a bookmark at the start of the documnet
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="PG1"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
strPrevBM = "PG1"
'the current page the cursor is on
intCurrentPage = Selection.Information( _
wdActiveEndPageNumber)
intIndex = 1
'keep going until the end of the document is reached
While intCurrentPage <= intLastPage And flag = True
'if the end of the document hasn't been reached
If intPageCount + intCurrentPage <= intLastPage Then
Selection.GoTo what:=wdGoToPage, _
Which:=wdGoToNext, Name:=intPageCount _
+ intCurrentPage
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Else
Selection.EndKey Unit:=wdStory
End If
'get the current page number
intCurrentPage = Selection.Information( _
wdActiveEndPageNumber)
'create a new bookmark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="PG" & _
Selection.Information(wdActiveEndPageNumber) + 1
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
strNextBM = "PG" & _
Selection.Information(wdActiveEndPageNumber) + 1
'select between the two bookmarks
Selection.Start = ThisDocument.Bookmarks(strPrevBM).End
Selection.End = ThisDocument.Bookmarks(strNextBM).Start
'copy the selection
Selection.Copy
'create a new documnet
Set objDocument = Documents.Add
'activate the document
objDocument.Activate
'paste the copied text to the document
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.TypeBackspace
objDocument.SaveAs2 (strPath & "" & intIndex)
intIndex = intIndex + 1
objDocument.Close
ThisDocument.Activate
'delete the bookmarks
ThisDocument.Bookmarks(strPrevBM).Delete
ThisDocument.Bookmarks(strNextBM).Delete
'create a new bookmark
If intIndex = 10 Then
Beep
End If
If intCurrentPage < intLastPage Then
Selection.MoveRight Unit:=wdCharacter, Count:=2
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="PG" & _
Selection.Information( _
wdActiveEndPageNumber)
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
strPrevBM = "PG" & _
Selection.Information(wdActiveEndPageNumber)
'get the current page number
intCurrentPage = Selection.Information( _
wdActiveEndPageNumber)
Else
flag = False
End If
Wend
End If
End Sub |
Partager