【Word VBA】Excelファイルから名札を自動生成するWordマクロ

2016年2月2日

, ,

年末に中学校の同窓会がありました。25年ぶりに会う恩師や友人がいて1次会から話が止まらず盛り上がりました。みんなと連れだって3次会まで参加しました。あっという間に時間が過ぎました。

私は同窓会の受付係を担当しました。申込みをWebの申込みフォームで行い、このデータをExcelファイルにまとめ、当日の名簿や名札を作成しました。これらは今までのイベント（IJET-25）や自主開催セミナーで行っていることと同じことなのでスムーズにいきました。

「Excelファイルから名札」というと、Wordの「差し込み印刷機能」を思い浮かべる方も多いと思います。私は、名札作成には自作マクロを利用しています。というのも、差し込み印刷機能を習得する前にマクロで同じようなものを作ってしまったからです（笑）。

今回の記事では、この名札作成用のマクロを紹介します。シンプルなマクロにしましたが、このマクロは、宛名印刷にも応用できます。「差し込み印刷機能」を覚えるのが面倒な（笑）イベント企画者や幹事の方に活用いただけると思います。表記を自由に変えてご活用ください。

このマクロでできること

Excelファイルに記載した情報から名刺サイズ（A4で10枚）の名札を作成します。

役職、所属などを記載する1行目と名前を記載する2行目の2つの情報を表示します。

例えば、以下のようなExcelファイルを用意します。なんちゃって個人情報を用いて作りました。

マクロを実行するとExcelファイルを選択するダイアログボックスが表示されます。

ここでExcelファイルを選ぶと、こんな感じの表ができます。2列×5行の表です。市販の名札用紙を利用することを考えて、罫線には色がありません。

フォントのサイズは以下の通りです。好みに応じて変更してください。

マクロの解説

WordからExcelファイルを開きます。事後バインディング（Late Binding）という呼び出し方でExcelオブジェクトを立ち上げて、Excelを操作します。

事後バインディングでExcelオブジェクトを作った場合、Excelのメソッドやプロパティはポップアップのリストで表示されません。また、Excel用の変数（例えば、xlUp, xlDownなど）も使えません。

そういう意味で少し面倒なのですが、事前バインディング（Early Binding）という別の方法をとると、参照設定するライブラリのバージョンによってエラーが発生することがあります。

そのため、私は公開するマクロでは事後バインディングをしています。

マクロ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
Sub Excel名簿から名札作成()
 
　Dim ExcelApp As Object
　Dim myWorkBook As Object
　Dim myWorkSheet As Object
　Dim fd As FileDialog
　Dim vrtSelectedItem As Variant
　Dim myFilePath As String　'Excelファイルパス
　Dim i As Long
　Dim iMax As Long 'Excelファイルの最大行数
　Dim RowMax As Integer　'名札用紙の最大行数
　Dim newDoc As Document　'名札用新規ファイル
　Dim myTable As Table
　Dim myCell As Cell　'記入対象のセル
 
　'--------------------------------------------
　'Excelファイルの選択
　'--------------------------------------------
　Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
　With fd
　　.AllowMultiSelect = False
　　If .Show = -1 Then
　　　myFilePath = .SelectedItems(1)
　　Else
　　　Exit Sub
　　End If
　End With
 
　Select Case Right(myFilePath, 4)
　　Case ".xls", "xlsx"
　　　'何もしない
　　Case Else
　　　MsgBox "Excelファイルを選択してください。"
　　　Exit Sub
　End Select
 
　Set fd = Nothing
 
　Application.ScreenUpdating = False
 
　'--------------------------------------------
　'Excelファイルを開く
　'--------------------------------------------
　Set ExcelApp = CreateObject("Excel.Application")
　ExcelApp.Visible = False
　Set myWorkBook = ExcelApp.workbooks.Open(myFilePath)
 
　Set myWorkSheet = myWorkBook.worksheets(1)
 
　'ExcelファイルのA列の最終行を取得（-4162はxlUp）
　iMax = myWorkSheet.Cells(myWorkSheet.Rows.Count, 1).End(-4162).Row　
 
　'--------------------------------------------
　'用紙の設定（縦55mm、横91mmのA4の10面名刺サイズ）
　'--------------------------------------------
　Set newDoc = Documents.Add
 
　'行数の設定
　RowMax = Round((iMax - 1) / 2)
 
　'フォント設定
　With newDoc.Range.Font
　　.NameFarEast = "ＭＳ ゴシック"
　　.NameAscii = "Arial"
　　.NameOther = "Arial"
　　.Name = "Arial"
　　.Size = 10.5
　End With
 
　'余白設定
　With newDoc.PageSetup
　　.TopMargin = MillimetersToPoints(11)
　　.BottomMargin = MillimetersToPoints(6)
　　.LeftMargin = MillimetersToPoints(14)
　　.RightMargin = MillimetersToPoints(14)
　　.LinesPage = 53
　　.LayoutMode = wdLayoutModeLineGrid
　End With
 
　'表の作成
　Set myTable = newDoc.Tables.Add(newDoc.Range, RowMax, 2)
 
　With myTable
　　.Rows.HeightRule = wdRowHeightExactly
　　.Rows.Alignment = wdAlignRowCenter
　　.Rows.Height = MillimetersToPoints(55)
　　.Columns.Width = MillimetersToPoints(91)
　　.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
　End With
 
　'--------------------------------------------
　'書き込み
　'--------------------------------------------
　With myWorkSheet
　　For i = 2 To iMax
 
　　　'書き込み対象のセルオブジェクトの設定
　　　Set myCell = myTable.Cell(Int(i / 2), i Mod 2 + 1)
 
　　　'下の列（名前）
　　　With myCell.Range.Paragraphs(1).Range
　　　　.Font.Size = 34　'フォントサイズ
　　　　.InsertParagraphBefore
　　　　.ParagraphFormat.Alignment = wdAlignParagraphCenter　'中央揃え
　　　　.InsertBefore Text:=myWorkSheet.Cells(i, 2).Value
　　　　.InsertParagraphBefore
　　　End With
 
　　　'上の列（都道府県）
　　　With myCell.Range.Paragraphs(1).Range
　　　　.Font.Size = 22　'フォントサイズ
　　　　.InsertParagraphBefore
　　　　.ParagraphFormat.Alignment = wdAlignParagraphLeft '左揃え
　　　　.InsertBefore Text:=myWorkSheet.Cells(i, 3).Value
　　　End With
 
　　　DoEvents
　　Next i
　End With
 
　'--------------------------------------------
　'後処理
　'--------------------------------------------
　'Excelファイルを閉じる
　myWorkBook.Close
　DoEvents
 
　'処理後のExcelオブジェクトの解放部分
　Set myWorkBook = Nothing
　Set myWorkSheet = Nothing
　ExcelApp.Quit
　DoEvents
　Set ExcelApp = Nothing
 
　Set newDoc = Nothing
　Set myTable = Nothing
 
　Application.ScreenUpdating = True
　DoEvents
 
　MsgBox iMax - 1 & "名の名札を作成しました。"
 
End Sub

-コード
-, ,

S