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

年末に中学校の同窓会がありました。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)という別の方法をとると、参照設定するライブラリのバージョンによってエラーが発生することがあります。

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

マクロ


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 = "MS ゴシック"
  .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

トップへ戻る