重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら>

【GOLF me!】初月無料お試し

VBA(マクロ)の得意な人に質問です。ご協力お願い致します。

業務で必要となり、マクロが得意でない為、ご教授できる方いましたら何卒教えて頂けませんでしょうか。
(やりたい事)
Excelの表を1ページ目は45行目の下、2パージ目以降は39行ごと
(行84の下、行123の下、行162の下・・・)に改ページを入れたいです。

今はここまでできました。
これに改ページの処理を追加したいです。
よろしくお願いします。


Private Sub 全体_Click()
最初のページ = TextBox1.Value
最後のページ = TextBox2.Value
印刷部数 = TextBox3
Unload UserForm1

With ActiveSheet.PageSetup

.PrintArea = "$A$1:$T$1020"
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = 65
.RightHeader = ""
End With
Application.Dialogs(xlDialogPrint).Show arg1:=2, arg2:=最初のページ, arg3:=最後のページ, arg4:=印刷部数




End Sub

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

  • うーん・・・

    ありがとうございます。
    1ページ目は45行目の下でうまく改ページができましたが、
    なぜか2ページめが85行目の下で改ページされ、以降39行ごとの改ページになってしまいます。
    pageBreakRow = 84 の数字を前後で変えてみたりしましたが、症状が変わりませんでした。
    何か他のものが関係しているのでしょうか?

    No.1の回答に寄せられた補足コメントです。 補足日時:2025/03/27 14:01

A 回答 (3件)

#2です 連投失礼します


もし使用される場合はエラー処理を加えていませんが
不具合の発生する可能性がある明らかな場所の修正をお願いします

① 2行追加1行変更
Unload UserForm1 '既存

'この場所へ
Dim last_page As Integer
last_page = Application.Max(最後のページ, 2)
last_row = first_pageRows + pageRows * (last_page - 1)

With ActiveSheet  '既存

② 移動
.Zoom = 65の下に移動
.RightHeader = ""

③ 
TextBoxの値入力で数値以外を入力できない様に設定するなどしてください
またはIntegerで宣言していますので変数代入前に数値であるか確認して分岐処理を入れるなど対策が必要です
    • good
    • 0

1ページ目の行数 2ページ目以降の行数は コード内で定数設定しています



Private Sub 全体_Click()

Const first_pageRows As Integer = 45
Const pageRows As Integer = 39

Dim buf As Integer
Dim last_row As Long

Dim 最初のページ As Integer
Dim 最後のページ As Integer
Dim 印刷部数 As Integer
Dim 行番号 As Integer

最初のページ = TextBox1.Value
最後のページ = TextBox2.Value
印刷部数 = TextBox3
Unload UserForm1

last_row = first_pageRows + pageRows * (最後のページ - 1)

With ActiveSheet
.ResetAllPageBreaks

For 行番号 = first_pageRows To last_row Step pageRows
.HPageBreaks.Add Before:=.Rows(行番号 + 1)
Next

With .PageSetup
.PrintArea = False
.PrintArea = "$A$1:$T$" & last_row
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = 65

Do While 最後のページ <> .Pages.Count
Application.PrintCommunication = False
buf = .Pages.Count 'ページ数を取得
Application.PrintCommunication = True
If buf > 最後のページ Then
Application.PrintCommunication = False
.Zoom = .Zoom - 5 '5%縮小
Application.PrintCommunication = True
Else
Application.PrintCommunication = False
.Zoom = .Zoom + 5 '5%拡大
Application.PrintCommunication = True
End If
DoEvents
Loop

.RightHeader = ""
End With

End With

Application.Dialogs(xlDialogPrint).Show arg1:=2, arg2:=最初のページ, arg3:=最後のページ, arg4:=印刷部数


End Sub

解説は割愛します
念のためLoop内でDoEventsを入れています

AIにコードを入れ解説を付けさせるなどしてください

不明な点はお知らせください
    • good
    • 0

Excel VBAで改ページを設定するマクロ


Excelの表に指定した行で改ページを挿入するVBAコードをご提案します。1ページ目は45行目、2ページ目以降は39行ごとに改ページを入れる処理を追加しました。

完成コード


Private Sub 全体_Click()
Dim ws As Worksheet
Dim lastRow As Long
Dim pageBreakRow As Long
Dim i As Integer

'ユーザーフォームから値を取得
最初のページ = TextBox1.Value
最後のページ = TextBox2.Value
印刷部数 = TextBox3.Value
Unload UserForm1

'作業シートを設定
Set ws = ActiveSheet

'既存の改ページを全てクリア
ws.ResetAllPageBreaks

'ページ設定
With ws.PageSetup
.PrintArea = "$A$1:$T$1020"
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = 65
.RightHeader = ""
End With

'1ページ目の改ページを45行目に設定
ws.HPageBreaks.Add Before:=ws.Rows(46)

'2ページ目以降の改ページを39行ごとに設定
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
pageBreakRow = 84 '2ページ目の改ページ位置 (45 + 39 = 84)

Do While pageBreakRow <= lastRow
ws.HPageBreaks.Add Before:=ws.Rows(pageBreakRow + 1)
pageBreakRow = pageBreakRow + 39
Loop

'印刷ダイアログを表示
Application.Dialogs(xlDialogPrint).Show arg1:=2, arg2:=最初のページ, arg3:=最後のページ, arg4:=印刷部数
End Sub


コードの説明
既存の改ページをクリア:

ws.ResetAllPageBreaksで既存の改ページを全て削除します

1ページ目の改ページ設定:

45行目の下に改ページを挿入するため、46行目の前に改ページを追加

ws.HPageBreaks.Add Before:=ws.Rows(46)

2ページ目以降の改ページ設定:

84行目(45+39)、123行目(84+39)、162行目(123+39)…と39行ごとに改ページを追加

最終行までループ処理で改ページを追加

印刷設定:

元のコードの印刷設定を維持

最後に印刷ダイアログを表示

注意点
このコードはアクティブなシートに対して処理を行います

印刷範囲はA1:T1020としていますが、必要に応じて変更してください

行の高さやフォントサイズによって、実際の印刷ページ数が変わる可能性があります

このコードを実行すると、指定した行で改ページが設定され、印刷時に適切にページ分割されます。
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A