賞状データ作成

昨日まで「賞状印刷用データ」に必要な項目を、印刷にふさわしい
形に整えることに挑戦してきた。
infoment.hatenablog.com
infoment.hatenablog.com
infoment.hatenablog.com
infoment.hatenablog.com
今日も、昨日の続きから。

おさらいすると、賞状に反映すべき情報は以下の三つ。

  1. 部門 例)小学生三年女子 組手の部
  2. 順位 例)優勝
  3. 名前 例)山田花子

あらかじめフォント名やサイズ、印刷位置などを調整済みのWordファイルが
あって、これに反映したのち印刷したい。

ところでWord文章内の特定の位置に、特定のフォント名、サイズで文字列を
セットするには、どうすればよいのだろう?きっと方法があるのだろうけど、
私はその方法を未だ知らない。

ということで今回は、「既にセットされた文字を置換する」方式とした。
作戦はこうだ。

  1. 必要な情報を取得する。
  2. Wordのひな形を起動する。
  3. 部門名、順位、選手名をそれぞれ置換する。
  4. 置換後のファイルを、内容が解り易いファイル名で保存する。
  5. 一位~四位まで、これを繰り返す。

まずひな形ファイルを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

確認した結果が ↓ こちら。

↓ このように無事、各選手のデータを作成することができた。

上手くいった?いえいえ、何事にも「例外」は付きものなわけで。

次回に続きます。