Excelアンケート用紙に学校名と通し番号を連続印刷したい

質問

学校向けのアンケート用紙を作成しています。
学校ごとに通し番号をつけて連続印刷する方法を教えてください。

利用したいデータは次の２つです。
1) アンケート用紙（Excel）
2) 学校リスト（Excel）

1) のアンケート用紙には、
・「学校」欄
・「整理番号」欄
があって、そこに、学校名と学校ごとの通し番号を印字して、連続印刷したいと考えています。

2) の学校リストには以下のような項目があります。
学校名　調査人数
A学校　30
B学校　20
C学校　50
　：　　　：
このデータを利用して、A学校分のアンケート用紙には、「学校」欄にA学校の名が印字され、
「整理番号」欄には、1から30までの通し番号が印字された用紙を30枚分、
同様にB学校分は、B学校名と1から20までの通し番号を印字したものを20枚、
・・・というように、すべての学校のアンケート用紙を一気に連続印刷したいのです。

ちなみに、VBAに関しては全くの素人です。
はじめは、Excelで作成したアンケート用紙をWordに画像として貼り付けて、学校欄と整理番号欄をWord文書上に設けて差込印刷でやろうとしていました。
ですが、それだと調査人数をもとにして通し番号を振ることができず、ギブアップしました。
おそらくマクロを使うのだと思いますが、もし、マクロを使わなくてもすむ方法があれば、それも教えていただきたく、よろしくお願いします。

回答No.3

imogasi

これはＶＢＡを使わないとできないでしょう。自動印刷は関数では絶対できない。
難しいことを要求しておいて、＞VBAに関しては全くの素人です、はおかしい。ビジネスなどにエクセルを使いたければ、ＶＢＡを知らないとできないと、私は回答で説いています。
ーーー
ごく簡単な、中身が３行のＶＢＡでやって見せます。
ただ奇抜な工夫がいることはやむを得ません。頭のすっきりしたときに、下記例をたどり、どういう理屈か、また自分の場合どう変えればよいか考えてください。
ーー
Ｓｈｅｅｔ２に、学校リストがあるとします。
部数はテスト上少数にしました。
Ａ列に列挿入して
Ａ列　　Ｂ列　　Ｃ列　Ｄ列
0 A学校 3 0
4 B学校 2 3
6 C学校 5 5
11
Ａ列、Ｄ列は（Ａ１，Ｄ１を除き）関数の結果です。
ーー
Ａ１は０、Ａ２は=SUM($C$1:C1)+1と入れて学校数（３行）だけ下に
式を複写します。結果は上記のとおり。第１行目の学校からの累積数＋１であります。
Ｄ１は０、Ｄ２は=SUM($C$1:C1)と入れて下方向に式を複写。
ーー
Ｓｈｅｅｔ１をアンケート用紙として、印刷するものとします。
Ａ１には学校名をいれ、Ｂ１には学校ごと連番を入れます。
Ｄ１に総連番を入れます。色を白い文字色などにして見えなくするか
印刷範囲外に設定する。
ーー
Ｓｈｅｅｔ１のモデル
C学校 5 10
アンケート

問１ ＸＸＸ Ｙ Ｎ

問２ ＹＹＹＹＹ Ｙ Ｎ

問３ ＸＸＸＸＸ Ｙ Ｎ

問４ ＺＺＺ Ｙ Ｎ
ーー
印刷
ＶＢＥ画面の挿入ー標準モジュールに下記を貼り付ける。
Sub test01()
For i = 1 To 10
Worksheets("sheet1").Range("D1") = i
Worksheets("sheet1").Range("A1:E11").PrintOut
Next i
End Sub
注意　１０は前項類型数で書き換える。
　　　自動でＶＢＡで取れるが、ＶＢＡコードを難しくしないため、　　人間がセットすることで済ましているもの。
　　Range("A1:E11").の部分はアンケート用紙の印刷内容が含まれる
　　セル範囲を指定してください。
　　Ｓｈｅｅｔ１は現実のシート名に変更してください。
　　式の中のＳｈｅｅｔ２も同じ。
ーーー
Ａ学校３枚、Ｂ学校２枚、Ｃ学校％枚印刷しました。連番もうまくいきまた、

補足

ありがとうございます。早速挑戦してみました。
Excel関数の部分までは理解できましたが、上述のサンプルどおり実行してみたら、
Sheet1のD1に総連番は印字されたのですが、A1とB1は、すべて空欄になってしまいました。
貼り付け内容（↓）のうち、
Sub test01()
For i = 1 To 10
Worksheets("sheet1").Range("D1") = i
Worksheets("sheet1").Range("A1:E11").PrintOut
Next i
End Sub

学校リスト（sheet2）を差し込む指示がどれに当たるのでしょうか。
恐れ入りますが、もう少しご教示いただけないでしょうか。

回答No.2

zap35

＃０１です。

書き忘れました。先のマクロでは「アンケート用紙」シートと、「学校リスト」シートは一つのエクセルブックにあることを前提にしています

あと、もっと大事なことを書き忘れていました。WORDの差し込み印刷でも可能ですよ。差し込むエクセルのデータを
学校名　連番　
A　　　　　1
A　　　　　2
A　　　　　3
A　　　　　4
B　　　　　1
B　　　　　2
B　　　　　3
のように作れば良いだけではないでしょうか？

お礼

ありがとうございます。
上記アドバイスどおり、いまある学校リストを調査件数分のレコードに修正すると印刷できることは分かったのですが、その方法を実行するには件数が多すぎると思ったので、質問させていただいた次第です。まずはNo.1の方法にチャレンジしてみます。

回答No.1

zap35

どうしてもマクロが必要になります。
学校リストシートの学校名はA列、人数はB列にあるものとしてマクロを書いてみました。（もし違っていたらご自身では修正ができないでしょうから、すみませんがこの前提に合わせてください）

まず以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。

次にマクロの２～５行目を実際のシート構成にあわせて修正します。
マクロの実行はアンケート用紙シート画面に戻って、ALT＋F8でマクロ一覧を開き、マクロ名(QUESTIONNAIRE)を選択して「実行」ボタンです。

Sub QUESTIONNAIRE()
Const wsA As String = "アンケート用紙" 'アンケート用紙のシート名
Const wsG As String = "学校リスト" '学校リストのシート名
Const rngG As String = "A1" '学校名を挿入するセルアドレス
Const rngR As String = "A2" '連番を挿入するセルアドレス

Dim cnt, idx As Integer
　With Worksheets(wsG)
　　For idx = 1 To .Range("A65536").End(xlUp).Row
　　　If IsNumeric(.Cells(idx, "B").Value) And _
　　　　　　.Cells(idx, "B").Value > 0 Then
　　　　Worksheets(wsA).Range(rngG).Value = .Cells(idx, "A")
　　　　For cnt = 1 To .Cells(idx, "B").Value
　　　　　Worksheets(wsA).Range(rngR).Value = cnt
　　　　　ActiveSheet.PrintOut
　　　　Next cnt
　　　End If
　　Next idx
　End With
　Worksheets(wsA).Range(rngG).Value = ""
　Worksheets(wsA).Range(rngR).Value = ""
End Sub

＞VBAに関しては全くの素人です。
とのことですが、うまくいかないときは「どこまでやったら、どのような結果になった。どんなメッセージが表示された」かを明確に補足して下さい。ただ「うまくいきません」では補足回答のしようがありませんので(^^;

お礼

ありがとうございました。
設定して実行したらちゃんと印刷されました。