Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Use VBA to copy pages from one document to another

Status
Not open for further replies.
Feb 2, 2005
54
US
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.

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!
 
I am also seeing some strange activity with regards to header/footers....when I have a range of < 11 pages I do not get the header/footer but when the range is > 11 pages, I do get the header/footer...strange...

Thanks again for any insight you might have.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top