改ページ

いつもお世話になっております
下記のコードは
印刷範囲の設定のコードです

添付ファイルのように　改ページの破線っていうのか
黄色い部分を消すコードわかる方おしえてくれませんでしょうか

印刷範囲はRange("B3").CurrentRegion.Addressで
20行おきに改ページを挿入したいのですが、
わかりません。

ActiveSheet.ResetAllPageBreaksでもきえないのです。

With ActiveSheet
.PageSetup.PrintTitleRows = "$3:$3"
.PageSetup.PrintArea = Range("B3").CurrentRegion.Address

End With

質問者からの補足コメント

• 

  .HPageBreaks.Add BeforeRow:=Range("B3").Offset(i - 1).Row
  ここの部分で黄色くなりました。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/03/10 21:43

No.2 回答者： Qchan1962 回答日時： 2023/03/10 23:07

こんばんは

下記参考コードは少し曖昧さが残る　設定になります
改ページの破線はZoom 設定の問題だと思います
水平方向のPageBreakでは問題が残る可能性があると思います

印刷範囲Range("B3").CurrentRegionの20行目までを一旦　1ページとして
仮設定してZoom 設定を調整　その印刷倍率で
印刷範囲をRange("B3").CurrentRegionに設定し直し改ページを挿入する
手順のコードです

予め手作業でカラム方向を設定できるなら不要な処理かも知れません
.FitToPagesWide = 1 とする方法もあるかも知れませんが試していません

Dim buf As Integer
Dim i As Long
Dim printing_range As Range
Const pageBreak_lineCount As Long = 20
Set printing_range = Range("B3").CurrentRegion

With ActiveSheet
.PageSetup.PrintArea = ""
.ResetAllPageBreaks
With .PageSetup
.PrintArea = printing_range(1).Resize(pageBreak_lineCount, printing_range.Columns.Count).Address
.Zoom = 50
'Zoom設定参考サイト https://daitaideit.com/vba-zoom-fittopageswide/
Do
Application.PrintCommunication = False
.Zoom = .Zoom + 5 '5%だけ拡大する
Application.PrintCommunication = True
Application.PrintCommunication = False
buf = .Pages.Count 'ページ数を取得
Application.PrintCommunication = True
If buf > 1 Then '改ページされた場合
Application.PrintCommunication = False
.Zoom = .Zoom - 5 '5%だけ縮小する
Application.PrintCommunication = True
Exit Do
End If
Loop
.PrintTitleRows = "$3:$3"
.PrintArea = printing_range.Address
End With
'20行刻み改ページ設定
For i = 3 To printing_range.Rows.Count Step pageBreak_lineCount
.Rows(i).PageBreak = xlPageBreakManual
Next
End With

End Sub

この回答へのお礼

いつもありがとうございます。
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, regionindex:=1　このコード見つけました
ありがとうございます。

お礼日時：2023/03/10 23:20

No.1 回答者： ミラ-_- 回答日時： 2023/03/10 21:38

改ページを20行おきに挿入するには、以下のようにPageSetup属性のPrintTitleRows、PrintArea、そしてHPageBreaksオブジェクトを設定することができます。

With ActiveSheet
.PageSetup.PrintTitleRows = "$3:$3"
.PageSetup.PrintArea = Range("B3").CurrentRegion.Address
For i = 1 To .HPageBreaks.Count
.HPageBreaks(i).Delete
Next i
For i = 1 To Range("B3").CurrentRegion.Rows.Count Step 20
.HPageBreaks.Add BeforeRow:=Range("B3").Offset(i - 1).Row
Next i
End With


このコードでは、まずHPageBreaksコレクション内のすべての水平方向の改ページを削除します。次に、B3セルから現在の領域の最終行まで、20行ごとにループし、HPageBreaksコレクションに新しい改ページを挿入します。

この回答へのお礼

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

お礼日時：2023/03/10 23:20