マクロ内のページ範囲のコピー（Microsoft Word）

Sub CopyPages1()

Dim rCopy As Range

Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _       Which:=wdGoToAbsolute, Count:=7)

Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=9

rCopy.End = Selection.Bookmarks("\Page").Range.End

rCopy.Select End Sub

Sub CopyPages2()

Dim rCopy As Range     Dim rCurrent As Range

Set rCurrent = Selection.Range

Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _       Which:=wdGoToAbsolute, Count:=7)

Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=9

rCopy.End = Selection.Bookmarks("\Page").Range.End     rCopy.Copy     Documents.Add     ActiveDocument.Range.PasteSpecial

rCurrent.Select End Sub

Sub CopyPages3()

Dim rCopy As Range     Dim rCurrent As Range     Dim sTemp As String     Dim i As Integer     Dim iStart As Integer     Dim iEnd As Integer          Set rCurrent = Selection.Range

' Get page numbers to be copied     sTemp = InputBox("Page range to copy (use format 6-7)", "")

i = InStr(sTemp, "-")

If i > 0 Then         iStart = Val(Left(sTemp, i - 1))

iEnd = Val(Mid(sTemp, i + 1))

If iStart < 1 Then iStart = 1         If iEnd < iStart Then iEnd = iStart         With ActiveDocument.Range             If iStart > .Information(wdNumberOfPagesInDocument) Then                 iStart = .Information(wdNumberOfPagesInDocument)

End If             If iEnd > .Information(wdNumberOfPagesInDocument) Then                 iEnd = .Information(wdNumberOfPagesInDocument)

End If         End With

' Set the range         Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _           Which:=wdGoToAbsolute, Count:=iStart)

Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, _           Count:=iEnd         rCopy.End = Selection.Bookmarks("\Page").Range.End                  ' Copy range to a new document         rCopy.Copy         Documents.Add         ActiveDocument.Range.PasteSpecial

rCurrent.Select     Else         If sTemp > "" Then             MsgBox "There is no dash character"

End If     End If End Sub