ハガキの宛名書きを例に、簡単なデータを入力するために便利なInputBoxと印刷について
解説します。その他は、セクションＣ，Ｄで既に述べたコード例に同じです。なお、ここで示す
マクロは、「横書き」と「縦書き」の2つに分けられており、更に夫々一枚毎作成する場合と、
一括して複数毎作成する場合に分けられています。
末尾には、サンプルシートを掲げています。
Ｅ-1 横書一枚毎宛名作成
先ず、事前の準備として次のことをしましょう。
1）各自新規の練習用ブックを開き、マスターテーブルをシート名「名簿」に準備して下さい。
なお、以下の点に注意して下さい。
マスターテーブルの表全体のセル範囲が「マスターテーブル」の名前で正しく登録され
ているか確認して下さい。確認する際の注意事項は、C-1を参照して下さい。
2）別シートにシート名を「ハガキ横書宛名」、「ハガキ縦書宛名」とした空のシートを準備
して下さい。
以下に示す横書一枚毎宛名作成マクロでは、説明を必要とする新規関連コードの左端
行番号を赤い色で示します。
「横書一枚毎宛名作成」マクロプログラム
1 Sub 横書一枚毎宛名作成() '一枚毎にハガキ横書宛名
2 Dim masterTbl As Range, masterFld As Integer
3 Dim zip_code As String, name As String, address_1 As String, address_2 As String
4 Dim i As Integer 'Dimは変数の型宣言
5 '
6 Worksheets("名簿").Activate
'シート名「名簿」をアクティブシートにする
7 Set masterTbl = Range("マスターテーブル")
8 'マスターテーブルと名付けた表のセル範囲をmasterTblにセット
9 masterFld = 3 '生徒番号フィールドのmasterTbl内での相対的な列番号
10 For i = 2 To masterTbl.Rows.Count '見出しを除く2行目から最終行までの繰り返し
11 'iはmasterTbl内での相対的な行番号
12 If masterTbl.Cells(i, masterFld).Interior.ColorIndex
= 3 _
13 And masterTbl.Cells(i, masterFld).Interior.Pattern
= xlSolid Then
14 zip_code = masterTbl.Cells(i,
masterFld + 5) '郵便番号の読込
15 address_1 = masterTbl.Cells(i,
masterFld + 6) '住所１の読込
16 address_2 = " "
& masterTbl.Cells(i, masterFld + 7)
'住所２の読込
17 name = masterTbl.Cells(i,
masterFld + 1) & " 様"
'名前の読込
18 '
19 Worksheets("ハガキ横書宛名").Activate
20 'シート名「ハガキ横書宛名」をアクティブシートにする
21 Range("$A$1:$D$31").Select
22 Selection.ClearContents
23 Range("$D$2") =
zip_code
24 Range("$D$2").Font.Size
= 14
25 Range("$A$12").Font.Size
= 16
26 Range("$A$14").Font.Size
= 16
27 Range("$B$16").Font.Size
= 18
28 Range("$A$12")
= address_1
29 Range("$A$14")
= address_2
30 Range("$B$16")
= name
31 Exit Sub
32 End If
33 Next
34 Set masterTbl = Nothing 'オブジェクトの開放
35 End Sub
「横書一枚毎宛名作成」マクロプログラムの解説
12,13行目 ：セクションＣのＶＢＡマクロプログラム22,23行目に同じで、「もし、生徒番号
のセルの背景色が赤色で、且つ塗りつぶされているならば」の条件式です。
22行目 ：21行目で選択したセル範囲の内容をクリアーしなさい。
24〜27行目 ：Ａ1形式で指定されたセルの文字列のフォントサイズを指定ポイント数と
しなさい。
Ｅ-2 横書一括宛名作成
上記同様、説明を必要とする新規関連コードの左端行番号を赤い色で示します。
「横書一括宛名作成」マクロプログラム
1 Sub 横書一括宛名作成() '一括してハガキ横書宛名作成
2 Dim masterTbl As Range, masterFld As Integer, activeRng As Range
3 Dim zip_code As String, name As String, address_1 As String, address_2 As String
4 Dim i As Integer, A As String 'Dimは変数の型宣言
5 '
6 Worksheets("名簿").Activate
'シート名「座席表」をアクティブシートにする
7 Set masterTbl = Range("マスターテーブル")
8 'マスターテーブルと名付けた表のセル範囲をmasterTblにセット
9 masterFld = 3
10 For i = 2 To masterTbl.Rows.Count '見出しを除く2行目から最終行までの繰り返し
11 'iはmasterTbl内での相対的な行番号
12 If masterTbl.Cells(i, masterFld).Interior.ColorIndex
= 3 _
13 And masterTbl.Cells(i, masterFld).Interior.Pattern
= xlSolid Then
14 zip_code = masterTbl.Cells(i,
masterFld + 5) '郵便番号の読込
15 address_1 = masterTbl.Cells(i,
masterFld + 6) '住所１の読込
16 address_2 = "
" & masterTbl.Cells(i, masterFld
+ 7) '住所２の読込
17 name = masterTbl.Cells(i,
masterFld + 1) & " 様"
'名前の読込
18 '
19 Worksheets("ハガキ横書宛名").Activate
20 'シート名「ハガキ横書宛名」をアクティブシートにする
21 Range("$A$1:$D$31").Select
22 Selection.ClearContents
23 Range("$D$2")
= zip_code
24 Range("$D$2").Font.Size
= 14
25 Range("$A$12").Font.Size
= 16
26 Range("$A$14").Font.Size
= 16
27 Range("$B$16").Font.Size
= 18
28 Range("$A$12")
= address_1
29 Range("$A$14")
= address_2
30 Range("$B$16")
= name
31 A = InputBox("印刷しますか？ はい→
y, いいえ→n を入力して下さい")
32 If A = "y" Then
33 ActiveWindow.SelectedSheets.PrintOut
Copies:=1, Collate:=True
34 'アクティブシートの印刷
35 End If
36 End If
37 Next
38 Set masterTbl = Nothing 'オブジェクトの開放
39 End Sub
「横書一括宛名作成」マクロプログラムの解説
4行目 ：文字列変数Aの宣言を追加。この変数には、印刷の問い合わせに対する
ｙまたはｎが入力されます。
31行目 ：（）内の" "で囲まれた文字列がInputBoxに表示され、入力フィールドに
入力された値が変数Ａに文字列として代入されます。
32〜35行目 ：もし、Ａが"ｙ"に等しいならば、33行目を実行しなさい。
33行目は、「現在アクティブになっているシートを一部印刷しなさい」の
意味です。
Ｅ-3 縦書一枚毎宛名作成
縦書一枚毎宛名作成マクロでは、郵便番号以外の宛名を縦書きにすること、一部の
文字列を別の文字列に置換して縦書き変換することが新規関連コードです。先と同様、
左端行番号を赤い色で示します。
「縦書一枚毎宛名作成」マクロプログラム
1 Sub 縦書一枚毎宛名作成()
'一枚毎にハガキ縦書宛名
2 Dim masterTbl As Range, masterFld As Integer
3 Dim zip_code As String, name As String, address_1 As String, address_2 As String
4 Dim i As Integer 'Dimは変数の型宣言
5 '
6 Worksheets("名簿").Activate
'シート名「名簿」をアクティブシートにする
7 Set masterTbl = Range("マスターテーブル")
8 'マスターテーブルと名付けた表のセル範囲をmasterTblにセット
9 masterFld = 3 '生徒番号フィールドのmasterTbl内での相対的な列番号
10 For i = 2 To masterTbl.Rows.Count '見出しを除く2行目から最終行までの繰り返し
11 'iはmasterTbl内での相対的な行番号
12 If masterTbl.Cells(i, masterFld).Interior.ColorIndex
= 3 _
13 And masterTbl.Cells(i, masterFld).Interior.Pattern
= xlSolid Then
14 zip_code = masterTbl.Cells(i,
masterFld + 5) '郵便番号の読込
15 address_1 = masterTbl.Cells(i,
masterFld + 6) '住所１の読込
16 address_2 = " " &
masterTbl.Cells(i, masterFld + 7) '住所２の読込
17 name = masterTbl.Cells(i, masterFld
+ 1) & " 様" '名前の読込
18 '
19 Worksheets("ハガキ縦書宛名").Activate
20 'シート名「ハガキ縦書宛名」をアクティブシートにする
21 '*** 文字列の置換−→〜***
22 Range("$E$4") = address_2
23 Range("$F$4").Select
24 ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1],""-"",""〜"")"
25 '文字列縦書変換
26 With Selection
27 .HorizontalAlignment =
xlGeneral
28 .VerticalAlignment = xlTop
29 .WrapText = False
30 .Orientation = xlVertical
31 .AddIndent = False
32 .IndentLevel = 0
33 .ShrinkToFit = False
34 .ReadingOrder = xlContext
35 .MergeCells = False
36 End With
37 address_2 = Range("$F$4")
38 Range("$E$4:$F$4").Select
39 Selection.ClearContents
40 '***************
41 Range("$A$1:$C$6").Select
42 Selection.ClearContents
43 Range("$C$4").Orientation
= xlVertical
44 Range("$C$4").IndentLevel
= 0
45 Range("$B$4").Orientation
= xlVertical
46 Range("$A$4").Orientation
= xlVertical
47 Range("$C$2").Font.Size
= 14
48 Range("$C$4").Font.Size
= 16
49 Range("$B$4").Font.Size
= 16
50 Range("$A$4").Font.Size
= 18
51 Range("$C$2") = zip_code
52 Range("$C$4") = address_1
53 Range("$B$4") = address_2
54 Range("A$4") = "
" & name
55 Exit Sub
56 End If
57 Next
58 Set masterTbl = Nothing 'オブジェクトの開放
59 End Sub
「縦書一枚毎宛名作成」マクロプログラムの解説
21〜40行目 ：名簿の住所2を参照すると、条丁目が−で結ばれています。住所2欄を単に
縦書きしても−は縦棒になりません。一方、縦棒は1との区別が分かりづら
いので、−を〜に置換し、文字列を縦書に変換します。
24行目 ：Ｅ4セルの住所2を参照して、Ｆ4セルに−を〜に置換しなさい。
26〜36行目 ：With〜End With文については、セクションＤを参照のこと。ここでは、セルを
右クリック／セルの書式設定／配置で、方向；縦の文字列を選択し、更に
縦位置；上詰めとする一般操作と同一の「マクロの記録」コードを掲げています。
28行目が上詰めの指定です。
37行目 ：縦書きに変換した文字列をaddress_2に代入しなさい。
38,39行目 ：縦書き変換に使用した作業領域のセル内容をクリアーしなさい。
Ｅ-4 縦書一括宛名書作成
縦書きの一括宛名書きは、上のマクロに横書き一括マクロと同様の印刷の問い合わせ、
印刷関連のIf文を追加しただけです。下記には、マクロプログラムのみ掲げます。
「縦書一括宛名作成」マクロプログラム
1 Sub 縦書一括宛名作成()
'一括してハガキ縦書宛名
2 Dim masterTbl As Range, masterFld As Integer
3 Dim zip_code As String, name As String, address_1 As String, address_2 As String
4 Dim i As Integer, A As String 'Dimは変数の型宣言
5 '
6 Worksheets("名簿").Activate
'シート名「名簿」をアクティブシートにする
7 Set masterTbl = Range("マスターテーブル")
8 'マスターテーブルと名付けた表のセル範囲をmasterTblにセット
9 masterFld = 3 '生徒番号フィールドのmasterTbl内での相対的な列番号
10 For i = 2 To masterTbl.Rows.Count '見出しを除く2行目から最終行までの繰り返し
11 'iはmasterTbl内での相対的な行番号
12 If masterTbl.Cells(i, masterFld).Interior.ColorIndex
= 3 _
13 And masterTbl.Cells(i, masterFld).Interior.Pattern
= xlSolid Then
14 zip_code = masterTbl.Cells(i,
masterFld + 5) '郵便番号の読込
15 address_1 = masterTbl.Cells(i,
masterFld + 6) '住所１の読込
16 address_2 = " " &
masterTbl.Cells(i, masterFld + 7) '住所２の読込
17 name = masterTbl.Cells(i, masterFld
+ 1) & " 様" '名前の読込
18 '
19 Worksheets("ハガキ縦書宛名").Activate
20 'シート名「ハガキ縦書宛名」をアクティブシートにする
21 '*** 文字列の置換−→〜***
22 Range("$E$4") = address_2
23 Range("$F$4").Select
24 ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-1],""-"",""〜"")"
25 '文字列縦書変換
26 With Selection
27 .HorizontalAlignment =
xlGeneral
28 .VerticalAlignment = xlTop
29 .WrapText = False
30 .Orientation = xlVertical
31 .AddIndent = False
32 .IndentLevel = 0
33 .ShrinkToFit = False
34 .ReadingOrder = xlContext
35 .MergeCells = False
36 End With
37 address_2 = Range("$F$4")
38 Range("$E$4:$F$4").Select
39 Selection.ClearContents
40 '***************
41 Range("$A$1:$C$6").Select
42 Selection.ClearContents
43 Range("$C$4").Orientation
= xlVertical
44 Range("$C$4").IndentLevel
= 0
45 Range("$B$4").Orientation
= xlVertical
46 Range("$A$4").Orientation
= xlVertical
47 Range("$C$2").Font.Size
= 14
48 Range("$C$4").Font.Size
= 16
49 Range("$B$4").Font.Size
= 16
50 Range("$A$4").Font.Size
= 18
51 Range("$C$2") = zip_code
52 Range("$C$4") = address_1
53 Range("$B$4") = address_2
54 Range("A$4") = "
" & name
55 A = InputBox("印刷しますか？ はい→
y, いいえ→n を入力して下さい")
56 If A = "y" Then
57 ActiveWindow.SelectedSheets.PrintOut
Copies:=1, Collate:=True
58 'アクティブシートの印刷
59 End If
60 End If
61 Next
62 Set masterTbl = Nothing 'オブジェクトの開放
63 End Sub
Ｅ-5 ハガキ宛名書きサンプルシート
「ハガキ宛名書Readme」シート
「名簿」シート
「ハガキ横書宛名」シート
「ハガキ縦書宛名」シート
索引
ページの先頭へ戻る
目次へ戻る