賞状データ作成
昨日まで「賞状印刷用データ」に必要な項目を、印刷にふさわしい
形に整えることに挑戦してきた。
infoment.hatenablog.com
infoment.hatenablog.com
infoment.hatenablog.com
infoment.hatenablog.com
今日も、昨日の続きから。
おさらいすると、賞状に反映すべき情報は以下の三つ。
- 部門 例)小学生三年女子 組手の部
- 順位 例)優勝
- 名前 例)山田花子
あらかじめフォント名やサイズ、印刷位置などを調整済みのWordファイルが
あって、これに反映したのち印刷したい。
ところでWord文章内の特定の位置に、特定のフォント名、サイズで文字列を
セットするには、どうすればよいのだろう?きっと方法があるのだろうけど、
私はその方法を未だ知らない。
ということで今回は、「既にセットされた文字を置換する」方式とした。
作戦はこうだ。
- 必要な情報を取得する。
- Wordのひな形を起動する。
- 部門名、順位、選手名をそれぞれ置換する。
- 置換後のファイルを、内容が解り易いファイル名で保存する。
- 一位~四位まで、これを繰り返す。
まずひな形ファイルをC\Tempに保存。内容は、先日から少々変更した。
また、関数「生徒の名前」も「選手名」に変更。成人が選手の場合もあるので。
以上を踏まえて作成したのが ↓ こちら。
Sub 賞状作成() ' Excelで選んだ人の名前を格納するための配列。 Dim arr As Variant arr = 選手名 Dim SrcArray As Variant SrcArray = Array("部門名", "順位", "選手名") ' Microsoft Word *.* Object Libraryを事前に参照設定のこと。 ' 「Wordそのもの」を設定。 Dim objWord As Word.Application Set objWord = CreateObject("Word.Application") objWord.Visible = True ' 置換後の文字列を格納する配列を作成。 Dim DstArray(0 To 2) As Variant ' シート名が学年や男女・形名になっている。 DstArray(0) = 部門変換(ActiveSheet.Name) ' Word内の文字列。 Dim docDoc As Word.Document ' 文字列の置換。 Dim objFind As Word.Find Dim i As Long Dim j As Long For i = 0 To UBound(arr) DstArray(1) = 順位(i) DstArray(2) = arr(i) ' 原紙ファイルを開く。 Set docDoc = objWord.Documents.Open("C:\Temp\賞状ひな形.docx") Set objFind = objWord.Selection.Find ' 順番に文字列を置換。 For j = 0 To 2 objFind.ClearFormatting objFind.Text = SrcArray(j) objFind.Replacement.ClearFormatting objFind.Replacement.Text = DstArray(j) Call objFind.Execute(Replace:=Word.wdReplaceAll) Next ' 名前を付けてWordファイルを保存。 docDoc.SaveAs2 "C:\Temp\賞状_" & Format(i + 1, "00_") & Join(DstArray, "_") & ".docx" ' ファイルを閉じる。 docDoc.Close False Next ' 「Wordそのもの」を終了。 objWord.Quit MsgBox "ファイル作成しました。" End Sub
確認した結果が ↓ こちら。
↓ このように無事、各選手のデータを作成することができた。
上手くいった?いえいえ、何事にも「例外」は付きものなわけで。
次回に続きます。