| |
こんにちは
いつも参考にさせていただいています。
複数のシートの表を１枚のシートにまとめて印刷する という作業をVBAで行っています。
作業するファイルごとに表の行数は違っており（同一ファイルのシートの表の行数は同じ）、任意の行数から成る表を1枚のシートに横2×縦（可変個数）貼り付けています。
これを印刷のときには、表４つ分ずつ印刷したいと思っています。
↓イメージ
□□
□□
--改ページ
□□
□□
--改ページ
□□
改ページを先に入れて、その後印刷設定（横１×縦指定ページ）を入れると点線の改ページ（自動）が出てきて、うまく印刷できないため、何か方法はないかとネットで調べたところ、
改ページしたい行数insatugyoとシートの最終行を元に縦のページ数pを算定して、横１×縦pページで印刷するよう指定し（ここで改ページが自動で挿入されるようです）、その後、自動で入った改ページと印刷したい枚数に必要な改ページ数との過不足を調整します。必要数改ページが入ったら改ページの位置を指定の位置に移動させます。
という処理方法を見つけましたので、そのコードを元に下記のとおり記載しました。
実行したところ、（５）の改行の位置設定の箇所でエラーとなります。
例えば90行ごとに5ページ印刷する場合、（５）に処理が進んだ状態では、4つの改行が挿入されていますが、
１ループ目の
sh_B1.HPageBreaks(4)..Location = sh_B1.Range("A361")
を過ぎた後、
印刷設定の横１×縦５ページがいずれも「自動」に変更になり、改ページの数が上記で入れた改ページの１つのみになるため、次のループでsh_B1.HPageBreaks(3)が存在しなくなり、エラーとなります。
※なお、今テストで作っているシートでは、改ページの過不足は発生していないため（１）からすぐ（５）に処理がうつっている状況です。
エラーの出ない方法もしくは、別の方法で、希望の行数ごとに1枚に収めて印刷
する方法がありますでしょうか。
考え方のヒントでもけっこうですので、ご教示くださると幸いです。
よろしくお願いいたします。
===================================================================
With sh_B1
lRow = .Range("B" & Rows.Count).End(xlUp).Row '最終行を求める
p = lRow \ insatugyo + 1 '印刷ページ数を求める
End With
sh_B1.ResetAllPageBreaks '改ページリセット
With sh_B1.PageSetup
.Zoom = False
.FitToPagesWide = 1 '横１ページに収める
.FitToPagesTall = p '縦を指定のページ数に収める
End With
ActiveWindow.View = xlPageBreakPreview '改ページプレビュー
'印刷したいエリアごとに名前をつける Area1、Area2、・・・
With sh_B1
For i = 1 To p
Dim k As Integer 'エリア開始行を格納する変数
k = (i - 1) * insatugyo + 1
.Range("A" & k & ":M" & i * 2 * (chk + 1)).Name = "Area" & i
Next i
End With
Dim n As Integer
n = sh_B1.HPageBreaks.Count '……(1)'HPageBreaksの数を変数 n に代入。
If n > p - 1 Then
For i = n To p Step -1 '……(2)'印刷したいページ以上ある場合。以降の改ページを印刷範囲外に追い出す。
sh_B1.HPageBreaks(i).DragOff Direction:=xlDown, _
RegionIndex:=1
Next
ElseIf n < p - 1 Then
For i = 1 To n '……(3)'ページ数が足りない場合
Set sh_B1.HPageBreaks(i).Location = _
sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
Next
For i = n + 1 To p - 1 '……(4)'不足改行分を追加
sh_B1.HPageBreaks.Add _
sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
Next
End If
For i = p - 1 To 1 Step -1 '……(5)'改行の位置を設定
sh_B1.Activate
Set sh_B1.HPageBreaks(i).Location = _
sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
Next
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
