VBAで印刷ページ最終行にページ計表示印刷したい

いつもこのサイトでは有益な情報ばかりで大変助かっています。
質問ですが表題どうりで200行20列程度の行方向可変の集計表なのですが印刷する際に、表の最終行に表の合計は表示、印刷ともできるのですが、
各頁（40行程度）の合計はどのようにコードを書けば良いのかどなたか教えていただけないでしょうか。

No.9 ベストアンサー 回答者： onlyrom 回答日時： 2007/12/02 15:30

お待たせしました。

ちょとやぼ用がありアップが遅れたことお詫びします。

テストで使用したレイアウトは以下の通り。

見出し行：４行目　　データ開始は５行目から
　　（１、２行目に他のタイトルがあってもいいが、３行目は必ず空白行）
使用列：　Ａ～Ｎ列
　　（何列使用していてもコードの変更しなくていいです）
計算列：　Ｃ、Ｇ、Ｉ、Ｌ列
計の文字を入れる列：Ａ列
計の文字列　　　　　：《頁計》又は【合計】

●●Ａ列を基準にしていますので違う場合は適宜変更のこと
●●計算列も実際に合わせて適宜変更のこと
●●合計は予めＡ列最終行に、【合計】と入れ計算式も入れておくこと
　
'-------------------------------------------------------
Sub 頁計追加()
Dim PBK As HPageBreak
Dim PBKCount As Integer
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Dim EndRow As Long
Const DataBiginRow As Long = 5

If Range("A:A").Find("【合計】", , xlValues, xlPart) Is Nothing Then
　MsgBox "【合計】行がありません" & vbLf & vbLf & _
　　　　"【合計】行を手動で追加してから実行せよ" & vbLf, vbCritical
　Exit Sub
End If

Cells(Rows.Count, "A").End(xlUp).Select
PBKCount = ActiveSheet.HPageBreaks.Count

If PBKCount = 0 Then GoTo 印刷開始
If PBKCount = 1 And ActiveSheet.HPageBreaks(1).Location.Value = "" Then GoTo 印刷開始

Cells(Rows.Count, "A").End(xlUp).Select
PBKCount = ActiveSheet.HPageBreaks.Count

For Each PBK In ActiveSheet.HPageBreaks
　For R = PBK.Location.Offset(-1).Row To DataBiginRow Step -1
　　If Rows(R).Hidden = False Then
　　　Rows(R).Insert xlShiftDown
　　　Cells(R, "A").Value = "《頁計》"
　　　Exit For
　　End If
　Next R
Next PBK

Cells(Rows.Count, "A").End(xlUp).Select

If PBKCount <> ActiveSheet.HPageBreaks.Count Then
　Set PBK = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count)
　For R = PBK.Location.Offset(-1).Row To DataBiginRow Step -1
　　If Rows(R).Hidden = False Then
　　　Rows(R).Insert xlShiftDown
　　　Cells(R, "A").Value = "《頁計》"
　　　Exit For
　　End If
　Next R
End If

Cells(Rows.Count, "A").End(xlUp).Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Set PBK = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count)

If Not (PBK.Location.Value Like "*合計*") Then
　Rows(LastRow).Insert xlShiftDown
　Cells(LastRow, "A").Value = "《頁計》"
End If

Cells(Rows.Count, "A").End(xlUp).Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

StartRow = DataBiginRow

For R = DataBiginRow To LastRow - 1
　If Cells(R, "A").Value = "《頁計》" Then
　　EndRow = R - 1
　　Cells(R, "C").Value = _
　　　　"=Subtotal(9, C" & StartRow & ":C" & EndRow & ")"
　　Cells(R, "G").Value = _
　　　　"=Subtotal(9, G" & StartRow & ":G" & EndRow & ")"
　　Cells(R, "I").Value = _
　　　　"=Subtotal(9, I" & StartRow & ":I" & EndRow & ")"
　　Cells(R, "L").Value = _
　　　　"=Subtotal(9, L" & StartRow & ":L" & EndRow & ")"
　　StartRow = R + 1
　End If
Next R

With Range("A4").CurrentRegion.Borders
　.LineStyle = xlContinuous
　.Weight = xlThin
　.ColorIndex = xlAutomatic
End With

'-----
印刷開始:
　　ActiveSheet.PrintPreview　　'上手くいったらPrintOutにする
　　Call 頁計削除
End Sub
'------------------------------------------------------

列の非表示は場合によってパターンが色々あるでしょうから、印刷前に手動でした方がいいでしょう。
非表示の列は頁計削除のところで自動で表示されます。
もちろん、列の非表示も自動でできますが、その場合は、そのいくつかのパターンを別なセルにとっておき、それを利用するのがベターでしょう。
　
それから、合計行も自動で追加できますが、それはご自分でトライしてみてください。
　

この回答へのお礼

回答ありがとうございました。
先ほどサンプルで検証した結果、こちの思いどうりの動作結果でした。本当にありがとうございました。
改頁のメソッドを使用しているため、フィルタで絞り込んでも思いどうりに動作していました。
このコードでしたらほとんど手を加えることなく導入できそうです。

また機会がありましたら回答を宜しくお願いします。

お礼日時：2007/12/03 13:15

No.8 回答者： onlyrom 回答日時： 2007/11/30 11:14

おまたせしました、といいたいところですが、

Filter使用の方はまだ取り掛かっていません。
が、しかし、当方の回答履歴を見てもらえば分かると思いますが
回答したら必ず最後まで面倒をみることにしていますので
安心してお待ちください。

今日帰宅してから取り掛かる予定にしています。

また、再補足の
＞確かにフィルタを掛けて頁の最終行の判定をどのようにするのかいまいち頭に浮かびませんね

それは簡単です。

面倒なのは、フィルターを掛けて複数ページになったとき
ぞれぞれの頁の最後に「ページ計」を挿入することや、
それを挿入したことにより、ページ数が増えることがありますので
そこらあたりをどうするか等々いくつかあります。
フィルターを掛けない表であればそこらはあまり問題になりません。
　
以上。

No.7 回答者： onlyrom 回答日時： 2007/11/28 23:01

No.6 onlyromです。

何百行の表でもいいのですが、その表を印刷する。
但し、頁毎に「頁計」、最終行に「総合計」を追加して。

そんなふうだろうと考え、それで作成し、いまアップしようしましたが、
補足が書き込まれていましたのでそれを読んだところ、おい、おい、という感じです。

フィルターを掛けたものを印刷するなどの●根幹に関わること●は
最初の質問のとき言うべきことです。
何故なら、コードが複雑になるやも知れないからです。
（それについてはまだ考えてないのでどうなるかは分からないが）

ま、それはそうとして作成しなおしになりますので、
コードは明日になることをご了承ください。


それから、補足の内容に不足があります。

印刷は、ツールバーの印刷ボタンで実行するのか
自分でシートに配置したCommanButtonなどで実行するのか

追加した「頁計の行」は手動で削除マクロ実行か
自動で削除マクロ実行か
自動でする場合は、シートに削除ボタンを配置してそれでやるのか
シートに配置した、「印刷ボタン」で印刷と削除をやるのか

これらが補足されてないのでそれはこちらにお任せということで。
　
以上。
　

この回答への補足

回答ありがとうございいます
フィルタの件、ご指摘もっともな事でした。確かにフィルタを掛けて頁の最終行の判定をどのようにするのかいまいち頭に浮かびませんね。1頁に収まるとは限りませんよね。


最終行の合計だけ残して、頁計は印刷後に自動で削除すればいいと思っています。
印刷開始はシートに配置したボタンで実行でよいかと思います。

補足日時：2007/11/29 16:42

No.6 回答者： onlyrom 回答日時： 2007/11/28 18:09

質問の件は比較的簡単に（簡単とは習熟度による）できますが、

質問者はＶＢＡについてどれくらいのスキルがありますか？

（１）サクサクと扱える
（２）サンプルがあればそれを実際のレイアウトに合わせて修正できる
（３）マクロ記録しかしたことがない

（１）であればヒントをアップします。
（２）であればサンプルをアップします。
（３）であれば諦めましょう。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
（１）（２）であった場合のために、一応、以下を補足ください。
これは、当然ながら、ページ設定のシートタブの行タイトルが設定してあるんですよね。

Ａ）タイトル行は、何行目から何行目までか
Ｂ）データは何行目からか（タイトル行で分かるが）
Ｃ）また、最終行に合計は入れてないですよね。（自動で入れたほうがベター）
Ｄ）頁計合計行追加のタイミングはどこか
　　１．ツールバーの印刷ボタンをクリックした時
　　２．自分でシートに印刷ボタンを配置してそれをクリックした時
Ｅ）頁計合計行の削除はどのタイミングにするか
　　上記Ｄ）の２　であれば印刷終了時に削除マクロ実行可能
　　それ以外は、印刷終了時に手動で削除マクロを実行するか
　　または、削除ボタンを配置しそれで削除マクロ実行するかしかない
Ｆ）実際の表は、横長２０列の表らしいが、
　　例えば、データが数行ほどしかないときは１頁に収まるか？

　　●収まらないときは非常に面倒になるのでパス(^^;;;●

サンプルは確認しやすいように、３列で実施する。

何れにしろ、自分で修正できないのであれば
変な動きをした時に対処できないので諦めたほうがいいでしょう。

以上。


　

この回答への補足

ご回答ありがとうございます。
（１）と（２）の中間程度のスキルですがなかなか応用が出来なくてお手間かけます。
A)　4行目から見出し行1行で5行目から実際のデータが入っています。
C)　現在は、最終行にSUBTOTALを入れています。これはフイルタで見える行だけ集計するためです。
行方向はデータの数が増えれば下方向に増加していくのでデータの増えるたびに計算式の入れ替えをしています。
E)　は印刷終了時に
F)　は出来ることなら不要な列を印刷時だけ非表示にする。

多少のバグ取り修正はできると思いますので
以上ですが宜しくお願いします。

補足日時：2007/11/28 19:43

No.5 回答者： fumufumu_2006 回答日時： 2007/11/27 20:34

ANo.1です。

うーん、ANo.3さんの言う通りみたいです・・・
適当なイベントが無いので、１ページ印刷用シートを用意して１ページ分の値をコピーして印刷を繰り返すのが現実的みたいです。
ただ、印刷用ページに計算式を入れておけば、数値をコピーするだけで済みます。
総合計行の問題はのこりますが・・・

遅くなってこんな結論ですみません。
誰か妙案のある方いましたらお願いします。

この回答への補足

何度も回答ありがとうございます

別シートに印刷用のフォームを用意して内容の転記を行いそのページの最終行で集計する、と言うことですよね。
出来れば同じシートで一覧印刷する際に各ページごとにページ計を出したいのです。

補足日時：2007/11/28 13:40

No.4 回答者： fumufumu_2006 回答日時： 2007/11/27 17:23

ANo.1です。

ANo.2でもありますが・・・
私が補足を見間違ってました。
エクセル2003ですね。
しばしご猶予を・・・

この回答への補足

印刷ページ最終行に行を挿入しsubtotal関数をコピーする、こんなコードは書けないでしょうか

補足日時：2007/11/28 15:33

No.3 回答者： imogasi 回答日時： 2007/11/27 16:39

多分エクセルかアクセスの話ではないかと思うが、質問にどちらか書いてありますか？。

質問者の頭の中は他人にわかっていると勘違いしてませんか。質問者に良くある勘違いです。みんなあなたと同じことを考えているわけじゃない。
ーー
エクセルの話として見ます。
改ページしないで、印刷するメソッドがエクセルVBAにあれば
例えば、　店番順のデータとして、店番号が　変化したとき
・（１）明細行を印刷（ただし印刷後改ページしないで最終行で止まってくれる）
・（２）ページ合計を計算して置いて、合計行を１行（等)印刷
・（３）改ページ指令発行、または（２）を現状のPrintOutメソッド
のように利用する
ができれば良いが、多分できない。エクセルVBAの片手落ち？（私が知らないだけ？）
ーーー
それで
（A)上記（１）を別の印刷シートにコピーして整える
（B)そして（２）に当たる行を、その印刷シートの上記の直下行か、所定行（質問者の帳票仕様で決まる）に合計値等をセットする
（C)PrintOutメソッドで（A)から（B)含む行と、最右列間での範囲（Range）をPrintOut（Rangeのメソッド）する。
以上を同一印刷シート状で各ページ分だけ繰り返す。
印刷後変わる範囲はクリアーが必要です。

この回答への補足

遅くなりましてすいません。
最初の質問内容に、エクセルと書き忘れていまして混乱させてすいませんでした。

回答内容は、まだ理解できておりませんがじっくりと解析してみます。
でも難しそうですね。

補足日時：2007/11/28 13:35

No.2 回答者： fumufumu_2006 回答日時： 2007/11/27 16:36

ANo.1です。

多分2003以降でも動くと思いますが・・・
だめだったら教えてください。

No.1 回答者： fumufumu_2006 回答日時： 2007/11/27 15:41

VBAと言っても色々ですが、access(とりあえずaccess2000です）のvbaの事だとすると、こんなのでしょうか？

まず、ページフッターに列分の合計を表示するための、非連結のテキストボックスを用意します。
ページ計1,ページ計2,...ページ計20とします。

ページヘッダーセクションのイベントのフォーマット時を下のようにします。
Private Sub ページヘッダーセクション_Format(Cancel As Integer, FormatCount As Integer)
'ページ計の初期化
ページ計1 = 0
ページ計2 = 0
ページ計3 = 0
・・・
ページ計19 = 0
ページ計20 = 0
End Sub

詳細セクションのイベントの印刷時を下のようにします。
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
'ページ計の計算
ページ計1 = ページ計1 + フィールド1
ページ計2 = ページ計2 + フィールド2
ページ計3 = ページ計3 + フィールド3
・・・
ページ計19 = ページ計20 + フィールド20
ページ計20 = ページ計20 + フィールド20
End Sub

どうでしょうか。

p.s.
場合によってはFormatCountやPrintCountを見ないといけない場合もあるかもしれません・・・
詳細セクションのイベントの印刷時を、フォーマット時にはしないでください。
次のページの先頭行を加えた数字になる場合があります。

この回答への補足

早速のご回答有難うございます。
質問内容の足らないところがありすいません。
エクセル2003以降でのVBAでのコード記述で何とかならないでしょうか。

ご回答お待ちしています。

補足日時：2007/11/27 16:15