Word VBA質問箱 IV

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

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


1 / 298 ツリー 前へ→

【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 お礼[未読]

【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

【870】Re:ファイル分割
発言  マナ  - 19/4/24(水) 21:50 -

引用なし
パスワード
   ▼あおぎんこ さん:

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


具体的には、どうなるのでしょうか?

>myPageEnd = .Bookmarks("\page").Range.End 
>は、アクティブなページの文末を取得していると思うのですが、
>このワードファイルが表で構成されているためか、うまく取得できていないようです。

こちらも、なぜそう思うのでしょうか。

myPageEnd = .Bookmarks("\page").Range.End -2

としたら、どうなりますか。

>  myPageStart = myPageEnd

そのかわりに、こっちは、+2で。

 

【871】Re:ファイル分割
質問  あおぎんこ  - 19/4/25(木) 19:17 -

引用なし
パスワード
   ▼マナ さん:

レスポンスありがとうございます。

>具体的には、どうなるのでしょうか?

今のコードですと、i=2のときに myPage=4 なのですが
3ページ目の頭に移動し、従って3ページ目の1ページ分しかコピーしません。
i=3のときmyPage=6 なのですが4ページ目の頭に移動し、4ページ目の1ページ分しかコピーしません。

文末がうまく取得できていないと思ったのは、作成された分割ファイルが型崩れしていたからですが、
.Range(myPageStart, myPageEnd).Copy 
の前に
.Range(myPageStart, myPageEnd).select
で選択範囲を明示してみたところ、
カーソルのあるページの末尾まできちんと選択されていましたので、こちらは問題なさそうです。きちんと確認しないまま投稿してしまい、申し訳ありません。


Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=myPage
↑このコードだと、myPageの数値にかかわらず、一つずつしか進まないようなのですがmypageのページ数に行くという意味ではないのでしょうね?
(すみません、Selection.GoToで検索してみたのですがいまいちどういう動きをするのか・・。)
指定ページに行くようなコードはあるのでしょうか?
検索の仕方もあるのでしょうが、なかなかこれというのが見つかりません。
ご教示いただけると幸いです。
よろしくお願いいたします。

【872】Re:ファイル分割
発言  マナ  - 19/4/25(木) 21:31 -

引用なし
パスワード
   ▼あおぎんこ さん:

これだとどうなりますか
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=myPage


動作確認のために、ほとんど同じですが、書き換えてみました。

Sub test()
  Dim mySplit As Long
  Dim doc As Document
  Dim myTotalPage As Long
  Dim myPage As Range
  Dim r As Range
  Dim k As Long

  mySplit = 2

  Set doc = ActiveDocument
  
  myTotalPage = doc.Range.Information(wdNumberOfPagesInDocument)

  Set myPage = doc.Range(0, 0)
  Set r = myPage
  
  k = 0

  Do Until k > myTotalPage
    k = k + mySplit
    myPage.Start = r.End
    If k >= myTotalPage Then
      myPage.End = doc.Range.End
    Else
      Set r = r.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=k + 1)
      myPage.End = r.Start - 1
    End If
    myPage.Copy
    Documents.Add.Range.Paste
  Loop

End Sub

【873】Re:ファイル分割
お礼  あおぎんこ  - 19/4/26(金) 9:14 -

引用なし
パスワード
   ▼マナ さん:
さっそくのご回答ありがとうございます。

>これだとどうなりますか
>Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=myPage

これだときちんと2ページずつ選択できました!

>
>動作確認のために、ほとんど同じですが、書き換えてみました。
>

そして書き換えてくださったコード。
同じようにしっかり分割できました!

今はレイアウトが違うので、新規ファイルは3ページになったりしてますけど、無事に2ページずつ分割できました。
これでページレイアウトを設定して、1ファイルずつ任意の名前をつけて保存できるように、コードを加えていきたいと思います。

またわからなくなったら質問させてください。

ありがとうございました。

【874】Re:ファイル分割
質問  あおぎんこ  - 19/4/26(金) 12:07 -

引用なし
パスワード
   ▼マナ さん:

さっそく追加質問をさせてください。

ファイルを保存するときに、分割元ファイルにある文字をファイル名にしたいと考えています。

使用したい文字の位置は一定ではないのですが、必ず「番号」という文字があるセルの次のセルに入っているので、
「番号」を検索し、右に一つタブ移動し取得した文字列をファイル名の変数に格納という方法で何とか取得できないかと考えているのですが
検索はできるのですが、見つかった個所を選択するというのができずにいます。

myPage内に必ず1つ「番号」はあるので、myPageの範囲確定後に
検索文字列を赤で表示するコードを参考に下記のように記述しています。

with myPage.Find
.text="番号"
Do While .Execute
myPage.HighlightColorIndex= wdRed
Loop
End With

これで赤く表示されるのですが、カーソルは動いていないので、
検索文字列に一つ右というのがうまくいきません。
検索文字にカーソルを持っていきたいのですが、方法がよくわかりません。
myPage.HighlightColorIndex= wdRed をどのように変えたらいいのか。。
検索文字にカーソルが移動できたら、
その後は
Selection.MoveRight Unit:=wdCell
で右に一つカーソル移動し
その文字列をコピーすればいいのかなと思っております。(ここはまだコードを思いついていませんがなんとか)

もしくはファイル名をうまく取得できる方法がほかにありましたら、ご教示いただけると幸いです。

よろしくお願いいたします。

【875】Re:ファイル分割
発言  マナ  - 19/4/26(金) 18:06 -

引用なし
パスワード
   ▼あおぎんこ さん:

こんな感じでできると思います。

Sub test()
  Dim myPage As Range
  Dim r As Range
  Dim s As String

  Set myPage = ActiveDocument.Range
  Set r = myPage.Duplicate

  With r.Find
    .Text = "番号"
    If .Execute Then
      If r.Information(wdWithInTable) Then
        s = r.Cells(1).Next.Range.Text
        s = Left(s, Len(s) - 2)
      End If
    End If
  End With

  MsgBox s

  myPage.Select

End Sub


この操作が、ファイル分割の後で
myPage の範囲が変わってもよいのであれば
変数 r を使う必要ないです。


  

【876】Re:ファイル分割
お礼  あおぎんこ  - 19/5/8(水) 14:38 -

引用なし
パスワード
   ▼マナ さん:

すっかり遅くなってすみません。
ご教示ありがとうございます。
ご提示いただいたコードを試してみたところ、ばっちりできました。

ファイル分割のあとなので 変数rを使用しなくてもうまくいきました。
でも.Duplicateで複製する方法があるのですね。勉強になりました。

それと s = r.Cells(1).Next.Range.Textで次のセルのテキストを取得
したときに *が末尾に入ることや、*が2文字となることも今回勉強にな
りました。

今回分割したファイルを配布し、また回収して1つのファイルに結合する
予定です。
こちらは今コードを書いている途中です。
自力で頑張りますが、つまづいたときにはまた質問をさせてください。
どうぞよろしくお願いいたします。


>こんな感じでできると思います。
>
>Sub test()
>  Dim myPage As Range
>  Dim r As Range
>  Dim s As String
>
>  Set myPage = ActiveDocument.Range
>  Set r = myPage.Duplicate
>
>  With r.Find
>    .Text = "番号"
>    If .Execute Then
>      If r.Information(wdWithInTable) Then
>        s = r.Cells(1).Next.Range.Text
>        s = Left(s, Len(s) - 2)
>      End If
>    End If
>  End With
>
>  MsgBox s
>
>  myPage.Select
>
>End Sub
>
>
>この操作が、ファイル分割の後で
>myPage の範囲が変わってもよいのであれば
>変数 r を使う必要ないです。

1 / 298 ツリー 前へ→
ページ:  ┃  記事番号:
201900
(SS)C-BOARD v3.8 is Free