賞状印刷
- 2008/08/19 16:03
- カテゴリー:大会支援(ドッチボール)
賞状の印刷です。
まずエクセル上に賞状の用紙に合わせた内容をレイアウトしていきます。
今回は以前に作られたワードの賞状データがありましたので、そのデータをエクセル上にオートシェイプで乗っけていきました。
その後、印刷用のコマンドボタンを配置します、名称は賞状印刷ですかね。
何度か、印刷と位置変更を行い、賞状の中に納まるようにします。
その後、コマンドボタンに以下の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
まず、ブロック数分ループして、並べ替えた順位シートの上位2つを順番に取ってきます。(手抜きです、もう一つループさせれば、同じルーティンを通せるのに、めんどくさいもんだから2位の方はコピーして作っちゃいました)
次に印刷完了フラグが上がっていないのを確認
順位が出ているのを確認
順位シートの印刷項目と地区名とチーム名をシェイプに代入します。
その後、OPTIONで指定したプリンタで印刷をかけます。
そして、印刷完了を順位シートに書き込みます。
これで、順位がでたものから、順番に印刷を行うことが出来ます。
実際には、終了時に一気に印刷を行いました。
あとは、判子を押して完成です。
トロフィーの帯にも印刷が出来ると楽なんですが、これはさすがに手書きです。
でも、おかげで最後巴戦でじゃんけん大会になったにも関わらず、昨年より早く賞状を出すことが出来ました。
さて、次回最終回は、OPTIONの説明です。