Word VBA質問箱 IV

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

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


22 / 865 ←次へ | 前へ→

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

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

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

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

54 hits

【869】ファイル分割 あおぎんこ 19/4/24(水) 19:42 質問[未読]
【870】Re:ファイル分割 マナ 19/4/24(水) 21:50 発言[未読]
【871】Re:ファイル分割 あおぎんこ 19/4/25(木) 19:17 質問[未読]
【872】Re:ファイル分割 マナ 19/4/25(木) 21:31 発言[未読]
【873】Re:ファイル分割 あおぎんこ 19/4/26(金) 9:14 お礼[未読]
【874】Re:ファイル分割 あおぎんこ 19/4/26(金) 12:07 質問[未読]
【875】Re:ファイル分割 マナ 19/4/26(金) 18:06 発言[未読]
【876】Re:ファイル分割 あおぎんこ 19/5/8(水) 14:38 お礼[未読]

22 / 865 ←次へ | 前へ→
ページ:  ┃  記事番号:
202543
(SS)C-BOARD v3.8 is Free