Excel VBA質問箱 IV

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

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


7010 / 13644 ツリー ←次へ | 前へ→

【41723】改ページ設定 トホホ 06/8/21(月) 15:10 質問[未読]
【41724】Re:改ページ設定 ハチ 06/8/21(月) 15:37 回答[未読]
【41725】Re:改ページ設定 トホホ 06/8/21(月) 15:48 お礼[未読]
【41736】Re:改ページ設定 ichinose 06/8/21(月) 18:42 発言[未読]
【41761】Re:改ページ設定 トホホ 06/8/22(火) 9:39 お礼[未読]
【41766】Re:改ページ設定 ichinose 06/8/22(火) 12:35 発言[未読]
【41773】Re:改ページ設定 トホホ 06/8/22(火) 13:53 質問[未読]
【41783】Re:改ページ設定 Kein 06/8/22(火) 16:56 回答[未読]
【41790】Re:改ページ設定 ichinose 06/8/22(火) 22:08 発言[未読]

【41723】改ページ設定
質問  トホホ  - 06/8/21(月) 15:10 -

引用なし
パスワード
   マクロを使用して約3,000行からなる帳票を作成しました。
1ページの印刷行数を指定して印刷することは可能でしょうか?
またそれが不可能であれば、リストの左端列(A列)などに行番号を振っておくなどしてもよいのですが。
いつも手作業でページ割をしているのでいざ印刷するとなるとかなりの時間がかかっています。
どうかよい方法があれば教えてください。

【41724】Re:改ページ設定
回答  ハチ  - 06/8/21(月) 15:37 -

引用なし
パスワード
   ▼トホホ さん:
>またそれが不可能であれば、リストの左端列(A列)などに行番号を振っておくなどしてもよいのですが。

ここの意味は良くわかりませんが・・

HPageBreaksで縦の改ページは制御できます。
拡大・縮小とかをやっていると上手くいきませんので
ご注意を。
それも対応させるとなると・・・
わけがわからないことになります。
HPageBreaksで過去ログも探してみてください。

Option Explicit

Sub Test()

Const L As Long = 10 '区切る行数を指定 Testでは10行ずつ
Dim LastR As Long
Dim i As Long

  With ActiveSheet
    LastR = .Range("A65536").End(xlUp).Row
    .ResetAllPageBreaks
    i = L + 1
    Do While i <= LastR
      .HPageBreaks.Add .Cells(i, 1)
      i = i + L
    Loop
  End With

End Sub

【41725】Re:改ページ設定
お礼  トホホ  - 06/8/21(月) 15:48 -

引用なし
パスワード
   >
>ここの意味は良くわかりませんが・・
>
確かに意味がわかりませんね。
すみません<m(__)m>

ありがとうございます。過去ログも探しては見ましたが、
縮小印刷をして尚且つ行数もしていして、
改ページを決めるのは難しいようですね。
ただ単に10行ずつ改ページをするというのは出来るのですが、
言葉不足ですみません。
ありがとうございます。

【41736】Re:改ページ設定
発言  ichinose  - 06/8/21(月) 18:42 -

引用なし
パスワード
   ▼トホホ さん:
こんばんは。

>マクロを使用して約3,000行からなる帳票を作成しました。
>1ページの印刷行数を指定して印刷することは可能でしょうか?
>またそれが不可能であれば、リストの左端列(A列)などに行番号を振っておくなどしてもよいのですが。
>いつも手作業でページ割をしているのでいざ印刷するとなるとかなりの時間がかかっています。
>どうかよい方法があれば教えてください。

600行ぐらいでテストしましたが、遅いですよ!!
Excelは、印刷は不得意ですからねえ・・・。

新規ブックの標準モジュールに
'===============================================================
Sub main()
  With Range("a1:o600")
   .Formula = "=row()*column()"
   .Value = .Value
   MsgBox "サンプル作成"
   Application.ScreenUpdating = False
   Call pr_settei(.Cells, 60)
   Application.ScreenUpdating = True
   End With
  ActiveSheet.PrintPreview
End Sub
'==============================================================
Sub pr_settei(prng As Range, intervalline As Long)
'印刷のぺージ設定を行う
'input prng-----印刷設定を行うセル範囲
'   intervalline---改ページを行う間隔(行数)
  Dim ar As Range
  Dim sht As Worksheet
  Set sht = prng.Parent
  With sht
   .Parent.Activate
   .Activate
   .Cells.PageBreak = xlPageBreakNone '手動設定の解除
   ActiveWindow.View = xlPageBreakPreview
   .PageSetup.Zoom = 100
   .PageSetup.PrintArea = ""
  
   For idx = 1 To prng.Rows.Count Step intervalline
    Set ar = prng.Range(idx & ":" & idx + intervalline - 1)
    .PageSetup.PrintArea = ar.Address
    Call VDRGOFF(sht, ar) 'オートマチックの解除
    Call HDRGOFF(sht, ar)
    .HPageBreaks.Add .Range(.Cells(ar.Row + ar.Rows.Count, 1), .Cells(ar.Row + ar.Rows.Count, ar.Columns.Count))
    Next
   ActiveWindow.View = xlNormalView
   .PageSetup.PrintArea = prng.Address
   End With
End Sub
'====================================================================
Sub VDRGOFF(sht As Worksheet, rng As Range)
  On Error Resume Next
  Dim vv As VPageBreak
  For Each vv In sht.VPageBreaks
   If Not Application.Intersect(vv.Location, rng) Then
     vv.DragOff xlToRight, 1
     End If
   Next
  On Error GoTo 0
End Sub
'===================================================================
Sub HDRGOFF(sht As Worksheet, rng As Range)
  On Error Resume Next
  Dim hh As HPageBreak
  For Each hh In sht.HPageBreaks
   If Not Application.Intersect(hh.Location, rng) Then
    hh.DragOff xlDown, 1
    End If
   Next
  On Error GoTo 0
End Sub


これでmainを実行してみてください。

サンプルコードmainでは、

セル範囲A1〜N600までに適当なデータを配置した後、

60行おきに改ページします。

ページ設定が用紙サイズA4レベルでは、
それぞれのページは縮小されているはずです。

ということがしたいのでしょうか?


試してみてください。

【41761】Re:改ページ設定
お礼  トホホ  - 06/8/22(火) 9:39 -

引用なし
パスワード
   ▼ichinose さん:
>▼トホホ さん:
>こんばんは。
>
>>マクロを使用して約3,000行からなる帳票を作成しました。
>>1ページの印刷行数を指定して印刷することは可能でしょうか?
>>またそれが不可能であれば、リストの左端列(A列)などに行番号を振っておくなどしてもよいのですが。
>>いつも手作業でページ割をしているのでいざ印刷するとなるとかなりの時間がかかっています。
>>どうかよい方法があれば教えてください。
>
>600行ぐらいでテストしましたが、遅いですよ!!
>Excelは、印刷は不得意ですからねえ・・・。
>
>新規ブックの標準モジュールに
>'===============================================================
>Sub main()
>  With Range("a1:o600")
>   .Formula = "=row()*column()"
>   .Value = .Value
>   MsgBox "サンプル作成"
>   Application.ScreenUpdating = False
>   Call pr_settei(.Cells, 60)
>   Application.ScreenUpdating = True
>   End With
>  ActiveSheet.PrintPreview
>End Sub
>'==============================================================
>Sub pr_settei(prng As Range, intervalline As Long)
>'印刷のぺージ設定を行う
>'input prng-----印刷設定を行うセル範囲
>'   intervalline---改ページを行う間隔(行数)
>  Dim ar As Range
>  Dim sht As Worksheet
>  Set sht = prng.Parent
>  With sht
>   .Parent.Activate
>   .Activate
>   .Cells.PageBreak = xlPageBreakNone '手動設定の解除
>   ActiveWindow.View = xlPageBreakPreview
>   .PageSetup.Zoom = 100
>   .PageSetup.PrintArea = ""
>  
>   For idx = 1 To prng.Rows.Count Step intervalline
>    Set ar = prng.Range(idx & ":" & idx + intervalline - 1)
>    .PageSetup.PrintArea = ar.Address
>    Call VDRGOFF(sht, ar) 'オートマチックの解除
>    Call HDRGOFF(sht, ar)
>    .HPageBreaks.Add .Range(.Cells(ar.Row + ar.Rows.Count, 1), .Cells(ar.Row + ar.Rows.Count, ar.Columns.Count))
>    Next
>   ActiveWindow.View = xlNormalView
>   .PageSetup.PrintArea = prng.Address
>   End With
>End Sub
>'====================================================================
>Sub VDRGOFF(sht As Worksheet, rng As Range)
>  On Error Resume Next
>  Dim vv As VPageBreak
>  For Each vv In sht.VPageBreaks
>   If Not Application.Intersect(vv.Location, rng) Then
>     vv.DragOff xlToRight, 1
>     End If
>   Next
>  On Error GoTo 0
>End Sub
>'===================================================================
>Sub HDRGOFF(sht As Worksheet, rng As Range)
>  On Error Resume Next
>  Dim hh As HPageBreak
>  For Each hh In sht.HPageBreaks
>   If Not Application.Intersect(hh.Location, rng) Then
>    hh.DragOff xlDown, 1
>    End If
>   Next
>  On Error GoTo 0
>End Sub
>
>
>これでmainを実行してみてください。
>
>サンプルコードmainでは、
>
>セル範囲A1〜N600までに適当なデータを配置した後、
>
>60行おきに改ページします。
>
>ページ設定が用紙サイズA4レベルでは、
>それぞれのページは縮小されているはずです。
>
>ということがしたいのでしょうか?
>
>
>試してみてください。

ありがとうございます。
実際にためさせていただきました。
が・・・。あまりにも初心者のため、
どの部分を書き換えると実データが使用できるか
わかりません。
サンプルでは1から順に数字が並ぶのですが・・・。
たびたび申し訳ありませんがよろしくご指導をお願いします。

【41766】Re:改ページ設定
発言  ichinose  - 06/8/22(火) 12:35 -

引用なし
パスワード
   ▼トホホ さん:
こんにちは。

>実際にためさせていただきました。
>が・・・。あまりにも初心者のため、
>どの部分を書き換えると実データが使用できるか
>わかりません。
それは、私にもわかりません。だって、トホホ さんの実データがどんなものなのか
3000行のデータということ以外は情報がありませんから・・・。


>サンプルでは1から順に数字が並ぶのですが・・・。
サンプルデータはアクティブシートのセルA1〜O600というセル範囲のデータを
印刷することを考えていますから、このセル範囲に適当な数値を配置しました。
これを10ページで印刷することを例にあげました。

通常、これをこのままページ設定で「用紙サイズA4縦」で設定した場合、
10ページでは収まりませんよね。

これを

Call pr_settei(.Cells, 60)

というサブプロシジャーで 60行/1ページに収まるように縮小しています。

上記のコードを書き直せば、

Call pr_settei(range("a1:o600"),60)

としても同じです。


結果、60行が1ページの10ページ分の印刷データが
出来上がっていると思います。

まずは、これが、この結果がトホホ さんがなさりたいことなのか

サンプルコードから判断してください。

【41773】Re:改ページ設定
質問  トホホ  - 06/8/22(火) 13:53 -

引用なし
パスワード
   ご丁寧にありがとうございます。
初心者の私でもわかりやすく読ませていただいております。

私が印刷使用としている帳票は
A1:O1までに項目名が並んでいます。
残りのA2:O2393まではレコードです。
1行目は印刷タイトルに設定していますので
1ページの印刷行数はタイトルも含め101行にするつもりです。
ちなみにB4横の印刷設定にしています。以前にご教授いただいた
↓の中を修正すればすむという問題なのでしょうか?

Sub main()
  With Range("a1:o600")
 .Formula = "=row()*column()"
 .Value = .Value
 MsgBox "サンプル作成"
 Application.ScreenUpdating = False
 Call pr_settei(.Cells, 60)
 Application.ScreenUpdating = True
 End With
 ActiveSheet.PrintPreview
End Sub
 

【41783】Re:改ページ設定
回答  Kein  - 06/8/22(火) 16:56 -

引用なし
パスワード
   タイトル行の設定や用紙のサイズ・向きなどについては、
メニューのページ設定を選択し、ダイアログに手作業で
設定していった方が良いでしょう。マクロでそれをやると
時間がかかりますから。で、一枚の用紙に101行を印刷する
というところだけに絞ったマクロにするなら、
理屈の上では以下のようなコードになります。

Sub MyPrint()
  Dim i As Long
 
  For i = 2 To 2302 Step 100
   Cells(i, 1).Resize(100, 15).PrintOut Copies:=1
  Next i
End Sub

ただし、このままテストするわけにはいかないので、一枚印刷するたびに
「タイマー付きMsgBox」を出して、3秒間の間にキャンセルを
押さなければ、自動的に次の印刷に移る、という形に変更します。

Sub Test_Print()
  Dim WshShell As Object
  Dim i As Long, Ans As Long
 
  Set WshShell = CreateObject("WScript.Shell")
  For i = 2 To 2302 Step 100
   Cells(i, 1).Resize(100, 15).PrintOut Copies:=1
   Ans = WshShell.Popup("印刷を中止しますか", 3, , 36)
   If Ans = 6 Then Exit For
  Next i
  Set WshShell = Nothing
  MsgBox "印刷を終了します", 64
End Sub

【41790】Re:改ページ設定
発言  ichinose  - 06/8/22(火) 22:08 -

引用なし
パスワード
   こんばんは。

>ご丁寧にありがとうございます。
>初心者の私でもわかりやすく読ませていただいております。
>
>私が印刷使用としている帳票は
>A1:O1までに項目名が並んでいます。
>残りのA2:O2393まではレコードです。
>1行目は印刷タイトルに設定していますので
>1ページの印刷行数はタイトルも含め101行にするつもりです。
>ちなみにB4横の印刷設定にしています。以前にご教授いただいた
>↓の中を修正すればすむという問題なのでしょうか?
最初に申し上げたとおり処理は遅いですが、下記のコードの修正で済みます。


Sub main()
  With ActiveSheet.PageSetup
   .PrintTitleRows = "$1:$1"
’行タイトルの設定
   End With
  With Range("a1:o1")
   .Formula = "=""項目""&column()"
   .Value = .Value
   End With
'  見出しの設定↑   
  With Range("a2:o2393")
   .Formula = "=row()*column()"
   .Value = .Value
   MsgBox "サンプル作成"
   Application.ScreenUpdating = False
   Call pr_settei(.Cells, 100)
   Application.ScreenUpdating = True
   End With
  ActiveSheet.PrintPreview
End Sub

他のプロシジャーは前回と同じです。

これも新規ブックで試してください。

7010 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free