| |
ページの多いワードファイルを２ページずつ分割したいと思い、下記のコードを見つけました。
ワードＶＢＡは今回初めてなので、意味を検索しながら試行錯誤中なのですが
下記のコードでは、うまく２ページずつに分割できません。
下記のコードで、分割の最終位置を取得しているのですが、これがうまくいって
いないようで、最初の分割はうまくいくのですが、２番目からうまくいきません。
myPageEnd = .Bookmarks("\page").Range.End
は、アクティブなページの文末を取得していると思うのですが、
このワードファイルが表で構成されているためか、うまく取得できていないようです。
もう少し調べてみようと思いますが、検索をしてもあまり出てこないので
お詳しい方がいらっしゃれば、範囲指定の仕方についてヒントでもご教示いただけると助かります。
どうぞよろしくお願いいたします。
Sub 文書の分割()
Dim mySplit As Variant '分割後の文書あたりのページ数
Dim myTotalPage As Integer '分割対象の文書の総ページ数
Dim i As Integer
Dim iMax As Integer
Dim actDoc As Document '分割対象の文書
Dim newDoc As Document '分割後の文書
Dim myPage As Integer
Dim myPageStart As Long
Dim myPageEnd As Long
'デフォルトの分割用のページ数
Const myDefault As Integer = 2
'印刷レイアウトに変更
ActiveWindow.View.Type = wdPrintView
Set actDoc = ActiveDocument
'総ページ数
myTotalPage = actDoc.Range.Information(wdNumberOfPagesInDocument)
'何ページごとに分割するのか、ページ数を入力
Do
mySplit = InputBox("分割するページ数を入力してください。" & vbCr & _
"総ページ数：" & myTotalPage, "文書の分割", myDefault)
'キャンセルの場合終了
If mySplit = vbNullString Then Exit Sub
'総ページ数以上の場合に終了
If mySplit >= myTotalPage Then Exit Sub
Loop While IsNumeric(mySplit) = False
'分割数を算出
If myTotalPage Mod mySplit > 0 Then
iMax = (myTotalPage \ mySplit) + 1
Else
iMax = (myTotalPage \ mySplit)
End If
'分割する開始位置を代入（初期値）
myPageStart = 0
For i = 1 To iMax
'分割対象の文書を選択
actDoc.Activate
'分割を開始するページ番号
myPage = i * mySplit
'カーソル位置を移動
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=myPage
'分割する範囲をコピー
With ActiveDocument
If i <> iMax Then
'分割する最終位置を代入（最後の分割ではない場合）
myPageEnd = .Bookmarks("\page").Range.End
Else
'分割する最終位置を代入（最後の分割の場合）
myPageEnd = .Range.End
End If
'範囲を指定してコピー
.Range(myPageStart, myPageEnd).Copy
End With
'新規文書の追加
Set newDoc = Documents.Add
'貼り付け
newDoc.Range.Paste
'次の分割の開始位置を代入
myPageStart = myPageEnd
DoEvents
Next i
'分割対象の文書の先頭にカーソルを移動
With actDoc
.Activate
.Range(0, 0).Select
End With
Set actDoc = Nothing
Set newDoc = Nothing
End Sub
|
|
![[未読]](./data/word/image/read_icon.gif){kind=icon}
