初心者のためのExcel(エクセル)マクロVBA入門-成績表マクロの作成:成績表を出力して完成させる
今回で完成まで持っていきたいと思います。前回までで、必要なデータ(氏名や成績など)はすべて変数に格納してあります。後はこれを出力用のテンプレートを開いて、出力して、保存して、終わりです。
出力の処理としては
- テンプレートファイルを開く
- 成績表をテンプレートに出力する
- 成績表_個人名.xlsという名前で保存する
- 印刷チェックがついてたら、印刷プレビューを表示する
- 印刷が完了したら、テンプレートファイルを閉じる。
- 出力が完了しました。というメッセージでマクロ完了する
以上のような処理です。念のためもう一度<設計の回>でやった仕様を思い出してみましょう。
<仕様>
・成績表をマクロのフォーマットにしたがって入力する
・出席番号を入力フォームに入れる
・出席表出力ボタンを押すと確認ウィンドウが出る。
・はいを押すと成績表が「成績表_個人名.xls」として成績表フォルダの中に保存される
・成績表にはコメント欄があり、事前に設定したコメントも表示される。
・印刷チェックがあると印刷もされる。(印刷プレビュー)
では、出力処理を書いて行きましょう。
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 成績表を出力するメソッド ' OutputScore ' 引数:なし ' 戻り値:なし ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub OutputScore() On Error GoTo cmnErr ' テンプレートファイルのブックオブジェクトを格納する Dim wbkTemplate As Workbook ' テンプレートを操作するシートオブジェクトを格納する Dim shtPrsnlScore As Worksheet ' テンプレートファイルを開く ' 誤保存を防ぐためテンプレートは読み取り専用で開く Set wbkTemplate = Workbooks.Open(Filename:=mdlDefine.TEMPLATE_FILE_PATH, ReadOnly:=True) ' シートオブジェクトを作る Set shtPrsnlScore = wbkTemplate.Sheets("成績表") Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
プロシージャの最初と最後はお決まりです。後は、開いたファイルを操作するための準備をしています。
具体的には開いたテンプレートファイルのワークブックオブジェクトを格納し、そのブックオブジェクトにある成績表のシートオブジェクトを変数に格納しています。
これで、テンプレートの操作は、ほぼばっちり大丈夫です。正しくオブジェクトを指定するための準備が整いました。これをしないとおそらくブックが複数開いている状態での操作で間違いやすくなってしまいます。
さて、では出力処理をしていきましょう。
テンプレートの成績は今回ですと7行のB列に科目名、C列に点数です。念のため開始行などはConstステートメントで定数にしておき、繰り返しの処理For文で成績表を出力します。
'成績を出力する For i = tmpKamkuStartRow To tmpKamkuEndRow ' 科目名 shtPrsnlScore.Cells(i, "B").Value = mdlDefine.personalScoreData.arryKamoku(cnt).kamokuName ' 点数 shtPrsnlScore.Cells(i, "C").Value = mdlDefine.personalScoreData.arryKamoku(cnt).score Next
決まった場所に入力するならセルに名前をつけてしまう。
意外と便利なのが、セルに名前を付けること。例えばテンプレートファイルの名前とコメントの欄に名前を付けておきます。すると、通常であればRange("C3")とセルの行列を指定する必要がありますが、名前ですとRange(セル名)で入力する箇所を特定できるのです。こうしておけば、テンプレートのレイアウトが変更になっても、入力する場所のセルの名前は同じなので、プログラムを変更する必要がない。というわけです。
ではさっそくやってみましょう。
氏名のところに「simei」という名前でセルに名前を付けます。
このようにセルに名前を付けてしまえば後はRange("simei")でそのセルに値を出力したり内容を取得したりできるようになります。どうようにコメントの欄にもcommentAreaという名前を付けておきましょう。
後は、その名前の定義も定数としてmdlDefineに定義し、後は出力するようにセルに代入するだけです。
' 氏名を出力する shtPrsnlScore.Range(mdlDefine.CELL_NAME_SIMEI).Value = mdlDefine.personalScoreData.simei ' コメントを出力する shtPrsnlScore.Range(mdlDefine.CELL_NAME_COMMENT_AREA).Value = WorksheetFunction.VLookup(shtComment.Range("A:B"), mdlDefine.personalScoreData.cmntCode, 2, False)
コメントはVlookUpで。
コメントは前にやったVlookUpで取得しています。これなら一発です。こういう時にFindをつかってもその隣のセルを取得はできませんので、VLookUpの方が便利ですよね。
これで、出力は完成です。後は保存して、印刷プレビューを表示して、印刷が終わったら閉じればいいのです。
' 印刷チェックがあったら印刷プレビューを表示する If shtScore.chkbxPrintOutFlg Then shtPrsnlScore.PrintPreview End If ' テンプレートファイルを閉じる wbkTemplate.Close SaveChanges:=False Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
これで終わりです。出力は実は意外と簡単です。後はメインの処理に書き、メッセージを表示して完了です。
以上です。これですべて完了です。後は色々なパターンをテストしながら、より効率よくしてみたり、直したり、改良したりしていきましょう。一旦これで成績表マクロはおしまいです。何かを題材にして設計~マクロ作成までをやってみましたが、いかがだったでしょうか?正直かなり難しいところもあったと思います。しかし、あぁマクロを作るってこういうことなんだな。とか、こんな風に考えて作るんだな。ということを体感できたとは思います。
マクロはプログラミングなのだ!
今回のように作ることでマクロの作成がいかにプログラミングと同等か?ということもわかっていただけたと思います。マクロとは操作の記憶ではないんです。エクセルを自動で動かすための一連のプログラムなのです。プログラムなのでこのようにエクセルをあたかも1つのソフトやツールのように作成することが可能なのです。マクロは決して操作をただ自動化するだけではありません。マクロを作ることで業務そのものが大きく効率化し大きく変化するのです。
私は以前某インターネット通販の仕事していた時もこのマクロでツールを作ることで今までの作業を大幅に短縮し、売り上げが何倍にもなりました。作業を短縮することで新たな店舗拡大を行うことができるようになったのです。
ただのマクロです。ですが、小さいですがこれもソフトでありツールであり「システム」なのです。
プログラミングができると業務効率化やビジネスが見える
大げさに書いてますがあながちウソでもないと思っています。プログラミングはコンピュータに仕事をさせるためのものです。非常にロジカルにできています。このロジカルな考え方を身に着けることは様々なビジネスでも応用できると思います。それにより、今やっている業務は本当に無駄がないのか?生産性は?などを見直すような考え方ができるようになると思うのです。
何回にも分けて成績表マクロを作成したのは、そういう考え方を身に着けて欲しかったからです。実際にこれ手作業で作ったらおそらく成績表1人分で15分~30分です。10人作れば200分は堅いでしょう。マクロを作れば数秒です。期末やテストの度に作成することを考えるとこの時間短縮における効果は計り知れないと思います。
最後にすべてのプログラムを公開して、一旦この連載は終了です。次回からまた、改めてイチから初心者向けにお話をしたいと思います。途中で脱落した人もこっからまた読めばいいと思うよ。
成績表マクロ:全ソースコードを公開
このコードを全部コピーしてオブジェクト名も同じにすれば、たぶん動きます。動かない時はあなたの考え方やまだオブジェクトの理解が乏しいがために起きていることです。もう一度基礎の回を読み直してみてください。
成績表シート
- 出席番号入力フォーム
- オブジェクト名:txtSyussekiNumber
- 印刷チェックボックス
- オブジェクト名:chkbxPrintOutFlg
- 成績表出力ボタン
- オブジェクト名:btnOutput
コメントマスタシート
名前を付けたオブジェクト
成績表シート: shtScore
コメントマスタシート: shtComment
標準モジュール
- mdlDefine :定数、変数定義用モジュール
- mdlErrorCheck :エラーチェック用モジュール
- mdlInputScore :成績表入力用モジュール
- mdlMain :メイン処理用モジュール
- mdlOutputScore :成績表出力用モジュール
- mdlStartEnd :事前事後処理用モジュール
shtScore内ソースコード
イベントプロシージャのみでMainを呼ぶだけ
Option Explicit Private Sub btnOutput_Click() '一般のエラーをキャッチする On Error GoTo cmnErr Dim msgRet As Integer ' 成績表を出力しますか? msgRet = MsgBox(mdlDefine.MSG_CONFIRM_MACROSTART, vbYesNo + vbExclamation, mdlDefine.APP_TITLE) ' はいが押されたら・・・ If msgRet = vbYes Then 'メインの処理を呼び出すだけ Call mdlMain.Main End If 'マクロ終了 Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
mdlDefine内コード
Option Explicit Public Const APP_TITLE = "成績表マクロ" Public Const MSG_CONFIRM_MACROSTART = "成績表を出力します。" + vbCrLf + "よろしいですか?" Public Const ERROR_MSG1 = "出席番号を入力してください。" Public Const ERROR_MSG2 = "出席番号が存在しません。処理を終了します。" Public Const ERROR_MSG3 = "成績表の点数が不正です。処理を終了します。" Public Const ERROR_MSG4 = "出席番号が見つかりません。処理を終了します。" Public Const ERROR_MSG5 = "テンプレートファイルがありません。処理を終了します。" Public Const ERROR_MSG6 = "保存先が存在しません。処理を終了します。" Public Const ERROR_WINDOW_TITLE = "成績表マクロ:エラー" Public Const TEMPLATE_FILE_PATH = "C:\VBA\Template.xls" Public Const SEISEKI_FOLDER_PATH = "C:\VBA\成績表\" Public Const CELL_NAME_SIMEI = "simei" Public Const CELL_NAME_COMMENT_AREA = "commentArea" ' 科目のユーザー定義型 Private Type Kamoku kamokuName As String '科目名 score As Variant '点数 End Type ' 成績表変数 Public Type Seiseki '出席番号 skNum As String ' 氏名 simei As String ' コメントコード cmntCode As String ' 科目と点数配列 arryKamoku() As Kamoku End Type Public personalScoreData As Seiseki
mdlMain内コード
各処理用のモジュールにあるメソッドを呼び出すだけになっている。
Option Explicit Sub Main() '一般のエラーをキャッチする On Error GoTo cmnErr Dim strErrMsg As String ' 事前の処理をする Call mdlStartEnd.PreStart ' エラーのチェックをする '''' エラーならマクロを終了する If Not mdlErrorCheck.InputCheck(strErrMsg) Then ' エラーメッセージを表示する MsgBox strErrMsg, vbOKOnly + vbExclamation, mdlDefine.ERROR_WINDOW_TITLE Else ' 成績表を読み込む Call mdlInputScore.InputScore ' 成績表を出力する Call mdlOutputScore.OutputScore 'メッセージを表示して終了する MsgBox "成績表の出力が完了しました。", vbOKOnly + vbInformation, mdlDefine.APP_TITLE End If ' 事後の処理をする Call mdlStartEnd.PreEnd 'マクロ終了 Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
mdlErrorCheck内コード
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' 入力チェックのメソッド ' InputCheck ' 引数:なし ' 戻り値:Boolean ' エラーの場合はエラーメッセージを入れる ' エラーがない場合はFalseを返す ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function InputCheck(ByRef strErrMsg As String) As Boolean On Error GoTo cmnErr ' フォルダチェックのために使うオブジェクトを作成 Dim objFileSys As New FileSystemObject ' 出席番号が入力されてない場合 If shtScore.txtSyussekiNumber.Value = "" Then '' 出席番号を入力してください。 strErrMsg = mdlDefine.ERROR_MSG1 InputCheck = False Exit Function End If ' 出席番号入力に数字以外を入力した場合 If Not IsNumeric(shtScore.txtSyussekiNumber.Value) Then '' 出席番号が存在しません。処理を終了します。 strErrMsg = mdlDefine.ERROR_MSG2 InputCheck = False Exit Function End If ' 成績表の点数に数字以外が入っていた場合 If Not CheckScore Then '' 成績表の点数が不正です。処理を終了します。 strErrMsg = mdlDefine.ERROR_MSG3 InputCheck = False Exit Function End If ' 存在しない出席番号が入力された場合 If shtScore.Range("A:A").Find(What:=shtScore.txtSyussekiNumber.Value) Is Nothing Then '' 出席番号が見つかりません。処理を終了します。 strErrMsg = mdlDefine.ERROR_MSG4 InputCheck = False Exit Function End If ' 成績表テンプレートがない場合 If Dir(mdlDefine.TEMPLATE_FILE_PATH) = "" Then '' テンプレートファイルがありません。処理を終了します。 strErrMsg = mdlDefine.ERROR_MSG5 InputCheck = False Exit Function End If ' 指定している保存先がない場合 If Not objFileSys.FolderExists(mdlDefine.SEISEKI_FOLDER_PATH) Then '' 保存先が存在しません。処理を終了します。 strErrMsg = mdlDefine.ERROR_MSG6 InputCheck = False Exit Function End If '個別で作ったオブジェクトは破棄する。 Set objFileSys = Nothing ' エラーがないならとしてTrueを返す InputCheck = True Exit Function cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する '個別で作ったオブジェクトは破棄する。 Set objFileSys = Nothing Exit Function End Function '''''''''''''''''''''''''''''''''''''''''''''' ' 成績表チェックするメソッド ' 戻り値:Boolean(True/False) ' 成績表の点数が数字じゃないならFalseを返す。 '''''''''''''''''''''''''''''''''''''''''''''' Private Function CheckScore() As Boolean Dim i As Long, j As Long Const COL_C = 3 Const COL_G = 7 Const SCOREDATA_START_ROW = 4 '成績表をチェックする ' 4行目から成績表の最終行まで繰り返す For i = SCOREDATA_START_ROW To shtScore.Cells(Rows.Count, 1).End(xlUp).Row ' 算数(C列)から英語(G列)まで繰り返す For j = COL_C To COL_G ' 数字じゃなかったら・・・ If Not IsNumeric(shtScore.Cells(i, j).Value) Then 'Falseを返してメソッドを終わる CheckScore = False Exit Function End If Next Next '全部チェックして問題なければTrueを返す CheckScore = True End Function
mdlInputScore内コード
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 成績表を読み込むメソッド ' InputScore ' 引数:なし ' 戻り値:なし ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub InputScore() On Error GoTo cmnErr Const kamokuRow = 3 ' 科目名の行 Const KamokuCol = 3 ' 科目名の列開始 Const KamokuCol2 = 7 ' 科目名の列最後 Const RngSerch = "A:A" '検索範囲 Dim rngSeiseki As Range Dim i As Long, cnt As Long ' Findで成績表を特定する Set rngSeiseki = shtScore.Range(RngSerch).Find(What:=CLng(shtScore.txtSyussekiNumber.Value)) ' 成績表情報を読み込む ' 出席番号 personalScoreData.skNum = shtScore.txtSyussekiNumber.Value ' 氏名 personalScoreData.simei = shtScore.Cells(rngSeiseki.Row, "B").Value '配列インデックス cnt = 0 ' 成績表を読み込む For i = KamokuCol To KamokuCol2 ReDim Preserve personalScoreData.arryKamoku(cnt) personalScoreData.arryKamoku(cnt).kamokuName = shtScore.Cells(kamokuRow, i).Value personalScoreData.arryKamoku(cnt).score = shtScore.Cells(rngSeiseki.Row, i).Value cnt = cnt + 1 Next ' コメントコードを読み込む personalScoreData.cmntCode = shtScore.Cells(rngSeiseki.Row, "H").Value Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
mdlOutputScore内のコード
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 成績表を出力するメソッド ' OutputScore ' 引数:なし ' 戻り値:なし ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub OutputScore() On Error GoTo cmnErr Const tmpKamkuStartRow = 7 Const tmpKamkuEndRow = 11 Dim i As Long, cnt As Integer ' テンプレートファイルのブックオブジェクトを格納する Dim wbkTemplate As Workbook ' テンプレートを操作するシートオブジェクトを格納する Dim shtPrsnlScore As Worksheet ' テンプレートファイルを開く ' 誤保存を防ぐためテンプレートは読み取り専用で開く Set wbkTemplate = Workbooks.Open(Filename:=mdlDefine.TEMPLATE_FILE_PATH, ReadOnly:=True) ' シートオブジェクトを作る Set shtPrsnlScore = wbkTemplate.Sheets("個人成績表") ' 成績の配列カウンタを初期化 cnt = 0 ' 成績表を出力する ' '成績を出力する For i = tmpKamkuStartRow To tmpKamkuEndRow ' 科目名 shtPrsnlScore.Cells(i, "B").Value = mdlDefine.personalScoreData.arryKamoku(cnt).kamokuName ' 点数 shtPrsnlScore.Cells(i, "C").Value = mdlDefine.personalScoreData.arryKamoku(cnt).score ' 成績の配列インデクッスカウンタをアップ cnt = cnt + 1 Next ' 氏名を出力する shtPrsnlScore.Range(mdlDefine.CELL_NAME_SIMEI).Value = mdlDefine.personalScoreData.simei ' コメントを出力する shtPrsnlScore.Range(mdlDefine.CELL_NAME_COMMENT_AREA).Value = WorksheetFunction.VLookup(mdlDefine.personalScoreData.cmntCode, shtComment.Range("A:B"), 2, False) '名前を付けて保存する(テンプレートは閉じない) wbkTemplate.SaveCopyAs Filename:=mdlDefine.SEISEKI_FOLDER_PATH & "成績表_" & mdlDefine.personalScoreData.simei & ".xls" ' 印刷チェックがあったら印刷プレビューを表示する If shtScore.chkbxPrintOutFlg Then shtPrsnlScore.PrintPreview End If ' テンプレートファイルを閉じる wbkTemplate.Close SaveChanges:=False Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
mdlStartEnd内のコード
Option Explicit '''''''''''''''''''''''''''''''''''''' ' 事前処理のメソッド ' - ボタンを非活性にする(押せないようにする) ' - マウスポインタを砂時計にする(処理中です) ' - エクセルの画面更新をしないように設定する ' '''''''''''''''''''''''''''''''''''''' Public Sub PreStart() On Error GoTo cmnErr ' ボタンを非活性にする shtScore.btnOutput.Enabled = False ' 入力フォームも非活性にする shtScore.txtSyussekiNumber.Enabled = False ' マウスポインタを砂時計に Application.Cursor = xlWait ' 画面更新をしないように設定 Application.ScreenUpdating = False 'マクロ終了 Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub '''''''''''''''''''''''''''''''''''''' ' 事後処理のメソッド ' - ボタンを活性にする(押せるようにする) ' - マウスポインタを普通ににする ' - エクセルの画面更新をできるように設定する ' '''''''''''''''''''''''''''''''''''''' Public Sub PreEnd() On Error GoTo cmnErr ' ボタンを活性にする shtScore.btnOutput.Enabled = True ' 入力フォームも非活性にする shtScore.txtSyussekiNumber.Enabled = True ' マウスポインタを砂時計に Application.Cursor = xlDefault ' 画面更新をしないように設定 Application.ScreenUpdating = True 'マクロ終了 Exit Sub cmnErr: MsgBox "エラーが発生しました" & vbCrLf & _ "エラー番号:" & Err.number & vbCrLf & _ "エラーの種類:" & Err.Description, vbOKOnly + vbExclamation, _ mdlDefine.ERROR_WINDOW_TITLE 'マクロを終了する Exit Sub End Sub
以上!!今日はここまで!
これまで読んでいただいた皆様本当にありがとうございました。
この成績表マクロで何かわからないことがあれば、いつでもご質問ください。
かしこ