ふれまにっ

賞状の印刷です。

まずエクセル上に賞状の用紙に合わせた内容をレイアウトしていきます。
今回は以前に作られたワードの賞状データがありましたので、そのデータをエクセル上にオートシェイプで乗っけていきました。

その後、印刷用のコマンドボタンを配置します、名称は賞状印刷ですかね。

何度か、印刷と位置変更を行い、賞状の中に納まるようにします。

その後、コマンドボタンに以下のVBAを書いていきます。

    For i = 0 To 5
        If Worksheets("順位").Range("H" & i * 8 + 5) <> "" Then
            If Worksheets("順位").Range("J" & i * 8 + 5) = "" Then
                ActiveSheet.Shapes("Rectangle 3").Select
                Selection.Characters.Text = Worksheets("順位").Range("I" & i * 8 + 5)
                ActiveSheet.Shapes("Rectangle 4").Select
                Selection.Characters.Text = Worksheets("順位").Range("H" & i * 8 + 5) & " " & Worksheets("順位").Range("G" & i * 8 + 5)
                ActiveSheet.PrintOut ActivePrinter:=Worksheets("Option").Range("B5").Value
                Worksheets("順位").Range("J" & i * 8 + 5).Value = 1
            End If
        End If
        If Worksheets("順位").Range("H" & i * 8 + 6) <> "" Then
            If Worksheets("順位").Range("J" & i * 8 + 6) = "" Then
                ActiveSheet.Shapes("Rectangle 3").Select
                Selection.Characters.Text = Worksheets("順位").Range("I" & i * 8 + 6)
                ActiveSheet.Shapes("Rectangle 4").Select
                Selection.Characters.Text = Worksheets("順位").Range("H" & i * 8 + 6) & " " & Worksheets("順位").Range("G" & i * 8 + 6)
                ActiveSheet.PrintOut ActivePrinter:=Worksheets("Option").Range("B5").Value
                Worksheets("順位").Range("J" & i * 8 + 6).Value = 1
            End If
        End If
    Next i

まず、ブロック数分ループして、並べ替えた順位シートの上位２つを順番に取ってきます。（手抜きです、もう一つループさせれば、同じルーティンを通せるのに、めんどくさいもんだから２位の方はコピーして作っちゃいました）

次に印刷完了フラグが上がっていないのを確認
順位が出ているのを確認
順位シートの印刷項目と地区名とチーム名をシェイプに代入します。

その後、OPTIONで指定したプリンタで印刷をかけます。
そして、印刷完了を順位シートに書き込みます。

これで、順位がでたものから、順番に印刷を行うことが出来ます。
実際には、終了時に一気に印刷を行いました。

あとは、判子を押して完成です。

トロフィーの帯にも印刷が出来ると楽なんですが、これはさすがに手書きです。

でも、おかげで最後巴戦でじゃんけん大会になったにも関わらず、昨年より早く賞状を出すことが出来ました。

さて、次回最終回は、OPTIONの説明です。