保育料日付入力Form。一時保育時に、封筒に手書きで書いていることを楽にする。
保育料日付入力Formの作成の経緯
妻が仕事をするために１ヵ月の間に１２日、子どもを一時保育に預けています。その際に、毎回上記の添付写真の封筒を手書きで作っていました。
「それ面倒じゃない？」と聞くと、「いや、１月に１２回だけだからｗ」と返答され、ありえない！面倒くさい！意味わからん！と、私のよくわからない情熱が燃え、この作業を自動化するＶＢＡを作成することにしました。
１ 閲覧対象者
お子さんを一時保育などに預けており、毎回手書きで「保護者名」、「園児名」、「緊急連絡先」、「登園日」、「金額」を書いている方。
２ 得られる効果
手書きからの解放！！
処理イメージ↓↓
処理イメージ：「保育料日付入力Form」 pic.twitter.com/u1EVBUomV1
— かずやん_VBAerLv.６ (@y8bV4ty1wbkTjPd) 2021年1月12日
「登園日」以外は固定されているので、今回は日付を入力するという点にフォーカスを当てた仕様となっております。
仮に「登園日」以外に変更がある場合は、都度変更すればよいかと思います。
３ 設計
１ 「保護者名」、「園児名」、「緊急連絡先」、「金額」はマニュアル入力。
２ マクロ「登園日入力」を実行
３ ユーザーフォームが表示される。
４ 登園する日付のCheckboxをチェックし、登録ボタンをクリックする。
５ 日付が入力される。
４ コードの解説
コードの中身
標準モジュールが１つと、Formモジュール（Calender）１つ、計２つがあります。
＜標準モジュール＞
（Formモジュール（Calenderを呼出す（Show）するだけ）
＜フォームモジュール＞
標準モジュールは、今日の日付（Date）を取得してFormモジュール（Calender）を呼び出すだけです。なので、標準モジュールの説明は省きます。
メイン処理は、Formモジュール（Calender）になります。
Formモジュール（Calender）の処理
UserForm_Initialize処理（ここがメイン処理です！）
＜UserForm_Initializeのコード＞
Private Sub UserForm_Initialize() Dim Day_of_the_week(6) As String Day_of_the_week(0) = "日": Day_of_the_week(1) = "月": Day_of_the_week(2) = "火" Day_of_the_week(3) = "水": Day_of_the_week(4) = "木": Day_of_the_week(5) = "金" Day_of_the_week(6) = "土" '曜日のラベルを作成---------------------------------------------- Dim newLabel As MSForms.Label Dim k_Day_of_the_week As Byte For k_Day_of_the_week = 0 To 6 '名前をつけてラベルを追加 Set newLabel = Me.Controls.Add("Forms.Label.1", "lab_" & Day_of_the_week(k_Day_of_the_week)) With newLabel .Caption = Day_of_the_week(k_Day_of_the_week) 'キャプション .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 24 + (40 * k_Day_of_the_week) '左からの距離 .Top = 60 '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If Day_of_the_week(k_Day_of_the_week) = "日" Then .ForeColor = &HFF& '文字色を赤 ElseIf Day_of_the_week(k_Day_of_the_week) = "土" Then .ForeColor = &HFF0000 '文字色を青 Else .ForeColor = &H0& '文字色を黒 End If .TextAlign = fmTextAlignCenter End With Set newLabel = Nothing Next '________________________________________________________________ 'コンボボックス登録処理------------------------------------------ Dim i As Integer For i = -3 To 3 '前後3年分の年を登録 Me.cmb_year.AddItem CStr((Year(clndr_date)) + i) Next i For i = 1 To 12 '月を登録 Me.cmb_month.AddItem CStr(i) Next i Me.cmb_year = Year(clndr_date) '年を指定 Me.cmb_month = Month(clndr_date) '月を指定 '________________________________________________________________ '日付のcheboxを作成-------------------------------------------------- Dim DayLabel As MSForms.CheckBox Dim Left_IX As Integer, Top_IX As Integer, n As Byte Dim k_DayLabel As Byte Left_IX = 0: Top_IX = 0: n = 0 For k_DayLabel = 1 To 37 Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", "lab_Day_" & k_DayLabel) '名前をつけてラベルを追加 With DayLabel .Caption = k_DayLabel '後で削除 .TextAlign = fmTextAlignCenter .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 25 + (40 * Left_IX) '左からの距離 .Top = 100 + (18 * Top_IX) '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If k_DayLabel Mod 7 = 0 Then .ForeColor = &HFF0000 '文字色を青 ElseIf k_DayLabel Mod 7 = 1 Then .ForeColor = &HFF& '文字色を赤 Else .ForeColor = &H0& '文字色を黒 End If End With 'Debug.Print Me("lab_Day_" & k_DayLabel).Caption Set DayLabel = Nothing Left_IX = Left_IX + 1 n = n + 1 '７個作ったら、下に作る判定 If n = 7 Then n = 0 Top_IX = Top_IX + 1 Left_IX = 0 End If Next '____________________________________________________________________ Call spn_日付_Spinup 'この処理をしないと面倒なことに… End Sub
Formモジュール（Calender）の処理手順
１ 配列変数Day_of_the_weekに日曜～土曜日の文字列を格納します。
Dim Day_of_the_week(6) As String Day_of_the_week(0) = "日": Day_of_the_week(1) = "月": Day_of_the_week(2) = "火" Day_of_the_week(3) = "水": Day_of_the_week(4) = "木": Day_of_the_week(5) = "金" Day_of_the_week(6) = "土"
２ 曜日のラベルを作成
上の画像の通り、フォームモジュールには曜日のラベルはありません。ラベルを作るコードを記述しています。
＜ラベルを作成するコード＞
'曜日のラベルを作成---------------------------------------------- Dim newLabel As MSForms.Label Dim k_Day_of_the_week As Byte For k_Day_of_the_week = 0 To 6 '名前をつけてラベルを追加 Set newLabel = Me.Controls.Add("Forms.Label.1", "lab_" & Day_of_the_week(k_Day_of_the_week)) With newLabel .Caption = Day_of_the_week(k_Day_of_the_week) 'キャプション .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 24 + (40 * k_Day_of_the_week) '左からの距離 .Top = 60 '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If Day_of_the_week(k_Day_of_the_week) = "日" Then .ForeColor = &HFF& '文字色を赤 ElseIf Day_of_the_week(k_Day_of_the_week) = "土" Then .ForeColor = &HFF0000 '文字色を青 Else .ForeColor = &H0& '文字色を黒 End If .TextAlign = fmTextAlignCenter End With Set newLabel = Nothing Next '________________________________________________________________
「Set newLabel = Me.Controls.Add("Forms.Label.1", ラベル名）」この処理でラベルを作ります。作った後は、文字、配置などを微調整します。
蛍光線の部分のラベルが作成される。
３ コンボボックス登録処理
年、月のコンボボックスに値を代入します。年は±３年、月は１～１２の値を代入します。これで、±３年の日付の入力ができます。
＜コンボボックス登録処理のコード＞
'コンボボックス登録処理------------------------------------------ Dim i As Integer For i = -3 To 3 '前後3年分の年を登録 Me.cmb_year.AddItem CStr((Year(clndr_date)) + i) Next i For i = 1 To 12 '月を登録 Me.cmb_month.AddItem CStr(i) Next i Me.cmb_year = Year(clndr_date) '年を指定 Me.cmb_month = Month(clndr_date) '月を指定 '________________________________________________________________
４ 日付のcheboxを作成処理
ラベル同様に、カレンダーの日付もフォームモジュール内には存在しないので、コードから作成します。
＜日付のcheboxを作成するコード＞
'日付のcheboxを作成処理------------------------------------------ Dim DayLabel As MSForms.CheckBox Dim Left_IX As Integer, Top_IX As Integer, n As Byte Dim k_DayLabel As Byte Left_IX = 0: Top_IX = 0: n = 0 For k_DayLabel = 1 To 37 Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", "lab_Day_" & k_DayLabel) '名前をつけてラベルを追加 With DayLabel .Caption = k_DayLabel '後で削除 .TextAlign = fmTextAlignCenter .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 25 + (40 * Left_IX) '左からの距離 .Top = 100 + (18 * Top_IX) '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If k_DayLabel Mod 7 = 0 Then .ForeColor = &HFF0000 '文字色を青 ElseIf k_DayLabel Mod 7 = 1 Then .ForeColor = &HFF& '文字色を赤 Else .ForeColor = &H0& '文字色を黒 End If End With Set DayLabel = Nothing Left_IX = Left_IX + 1 n = n + 1 '７個作ったら、下に作る判定 If n = 7 Then n = 0 Top_IX = Top_IX + 1 Left_IX = 0 End If Next '____________________________________________________________________
「Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", チェックボックス名）」これで、日付のチェックボックスを作成します。
５ この処理をしないと面倒なことに…
最後にちょこんと書いてあるこのコード。
Call spn_日付_Spinup 'この処理をしないと面倒なことに…
何をしているかと言うと、スピンボタンをスピンアップしています。
なぜこんなことをするのか？変数clndr_dateにDate関数で日付を取っているから、翌月を表示するため…ではありません。解決できないエラーがあったからです(;^ω^)。
仮にこの処理をしなかった場合、フォームの表示は下の画像の通りになります。
UserForm_Initializeの処理が流れただけの結果となります。これではカレンダーとは言えません。
スピンボタンにスピンUP、Downしたときに、カレンダーを作成する処理を走らせています。
その処理を実行すると、カレンダーが作成されます。つまり、自分でもあまり分かっていません(;^ω^)
動いてるからいいかなぁ(;^ω^)という状態です。
故に、スピンUP、Down時のイベント処理「clndr_set」のなかで、 On Error Resume Nextでエラーを無視しています。
この理由がわかる方は教えていただけると幸いです。しかし、設計に対して必要な要件は満たしています。
朗報 エラーの原因わかりました。
結論
UserForm_Initializeの最後「Call spn_日付_Spinup 」→「Call clndr_set」。
そもそも、UserForm_Initializeでカレンダー作成処理をやっていないことが原因でした(;^ω^)
なので、カレンダー作成処理を実行すればOKです。noteも更新しておりますm(_ _"m)
ご指摘くださったお二方、本当にありがとうございましたm(_ _"m)
＜clndr_setのコード＞
Private Sub clndr_set() 'カレンダーの作成と表示 Dim yy As String, mm As Integer, i As Integer, n As Integer, endDay As Integer If Me.cmb_year = "" Or Me.cmb_month = "" Then Exit Sub '年か月どちらか入ってなければ中止 yy = Me.cmb_year '年 mm = Me.cmb_month '月 On Error Resume Next For i = 1 To 37 'ラベルの初期化 Me("lab_Day_" & i).Caption = "" Me("lab_Day_" & i).BackColor = Me.BackColor Next n = Weekday(yy & "/" & mm & "/" & 1) - 1 'その月の1日の曜日番号に、マイナス1したもの endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1"))) '月末日の算出 For i = 1 To endDay Me("lab_Day_" & i + n).Caption = i '日を入れる If CDate(yy & "/" & mm & "/" & i) = clndr_date Then Me("lab_Day_" & i + n).BackColor = RGB(200, 200, 200) 'TextBoxの日と同じなら色をつける Next i On Error GoTo 0 End Sub
この処理で、カレンダーを作成しています。
