Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

43 / 886

←次へ　｜　前へ→


	【869】ファイル分割

あおぎんこ - 19/4/24(水) 19:42 -


	引用なし

	パスワード

ページの多いワードファイルを２ページずつ分割したいと思い、下記のコードを見つけました。
ワードＶＢＡは今回初めてなので、意味を検索しながら試行錯誤中なのですが
下記のコードでは、うまく２ページずつに分割できません。

下記のコードで、分割の最終位置を取得しているのですが、これがうまくいって
いないようで、最初の分割はうまくいくのですが、２番目からうまくいきません。

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

349 hits

▼

【869】ファイル分割 あおぎんこ 19/4/24(水) 19:42