みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

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

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

利用したいデータは次の2つです。
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文書上に設けて差込印刷でやろうとしていました。
ですが、それだと調査人数をもとにして通し番号を振ることができず、ギブアップしました。
おそらくマクロを使うのだと思いますが、もし、マクロを使わなくてもすむ方法があれば、それも教えていただきたく、よろしくお願いします。

投稿日時 - 2007-07-11 18:00:38

QNo.3158808

暇なときに回答ください

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

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

問1XXXYN

問2YYYYYYN

問3XXXXXYN

問4ZZZYN
ーー
印刷
VBE画面の挿入ー標準モジュールに下記を貼り付ける。
Sub test01()
For i = 1 To 10
Worksheets("sheet1").Range("D1") = i
Worksheets("sheet1").Range("A1:E11").PrintOut
Next i
End Sub
注意 10は前項類型数で書き換える。
   自動でVBAで取れるが、VBAコードを難しくしないため、  人間がセットすることで済ましているもの。
  Range("A1:E11").の部分はアンケート用紙の印刷内容が含まれる
  セル範囲を指定してください。
  Sheet1は現実のシート名に変更してください。
  式の中のSheet2も同じ。
ーーー
A学校3枚、B学校2枚、C学校%枚印刷しました。連番もうまくいきまた、

投稿日時 - 2007-07-11 20:40:00

補足

ありがとうございます。早速挑戦してみました。
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)を差し込む指示がどれに当たるのでしょうか。
恐れ入りますが、もう少しご教示いただけないでしょうか。

投稿日時 - 2007-07-12 14:41:14

ANo.2

#01です。

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

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

投稿日時 - 2007-07-11 18:46:58

お礼

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

投稿日時 - 2007-07-12 09:59:51

ANo.1

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

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

次にマクロの2~5行目を実際のシート構成にあわせて修正します。
マクロの実行はアンケート用紙シート画面に戻って、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に関しては全くの素人です。
とのことですが、うまくいかないときは「どこまでやったら、どのような結果になった。どんなメッセージが表示された」かを明確に補足して下さい。ただ「うまくいきません」では補足回答のしようがありませんので(^^;

投稿日時 - 2007-07-11 18:35:58

お礼

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

投稿日時 - 2007-07-13 12:27:56

あなたにオススメの質問