runningphan
MIS
I have a document that is 120 pages long that individuals want to be able to specify specific pages within the document to extract and create a new document. For instance, they may want pages 1,3,9,35 for one new document and 2,88,94 for another. I found a way to do a range (1 - 10) but am wondering if I couldn't just have them specify the exact page numbers if they aren't in sequence.
Here is what I am currently doing with the range...it works great but I know they are going to want the ability to pick specific pages.
Thanks!
Here is what I am currently doing with the range...it works great but I know they are going to want the ability to pick specific pages.
Code:
Sub ExtractPages()
Dim rStart As String
Dim rEnd As String
Dim r As Range
Dim aDoc1 As Document
Dim aDoc2 As Document
Set aDoc1 = ActiveDocument
rStart = InputBox("Enter Beginning Page Number to Copy")
rEnd = InputBox("Enter Ending Page Number to Copy?")
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=rStart
With aDoc1.Bookmarks
.Add Range:=Selection.Range, Name:="Start"
End With
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=rEnd + 1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
With aDoc1.Bookmarks
.Add Range:=Selection.Range, Name:="End"
End With
Set r = aDoc1.Range(Start:=aDoc1.Bookmarks("Start").Start, _
End:=aDoc1.Bookmarks("End").End)
r.Select
Selection.Copy
Documents.Add DocumentType:=wdNewBlankDocument
Set aDoc2 = ActiveDocument
With aDoc2
.PageSetup.Orientation = wdOrientLandscape
End With
Selection.Paste
aDoc1.Activate
Selection.Collapse
aDoc1.Bookmarks("End").Delete
aDoc1.Bookmarks("Start").Delete
Set r = Nothing
Set aDoc1 = Nothing
aDoc2.Activate
Set aDoc2 = Nothing
End Sub
Thanks!