Option Explicit Dim Togetsu As Date Dim StartYobi As Integer 'サブルーチンDaySetから移動 Dim Tuitachi As Date 'サブルーチンDaySetから移動 'テキストボックスの文字色 Private Const Red = &HFF& Private Const Blue = &HFF0000 Private Const Black = &H0 Private Sub cbEnd_Click() '終了ボタンがクリックされた時 Unload Me End Sub Private Sub cbHyoji_Click() '表示ボタンがクリックされた時 Togetsu = CDate(tbNen & "/" & tbTuki & "/01") Call DaySet End Sub Private Sub cbKongetsu_Click() '今月ボタンがクリックされた時 Togetsu = Date Call DaySet End Sub Private Sub cbYokugetsu_Click() '翌月ボタンがクリックされた時 Togetsu = DateAdd("m", 1, Togetsu) Call DaySet End Sub Private Sub cbYokunen_Click() '翌年ボタンがクリックされた時 Togetsu = DateAdd("yyyy", 1, Togetsu) Call DaySet End Sub Private Sub cbZengetsu_Click() '前月ボタンがクリックされた時 Togetsu = DateAdd("m", -1, Togetsu) Call DaySet End Sub Private Sub cbZennen_Click() '前年ボタンがクリックされた時 Togetsu = DateAdd("yyyy", -1, Togetsu) Call DaySet End Sub Private Sub tbNen_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'カーソルが年のコントロールを出た時 If tbNen <= 1900 Or 2099 < tbNen Then MsgBox "1901〜2099年を入力してください", , "カレンダー" Cancel = True End If End Sub Private Sub tbTuki_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'カーソルが月のコントロールを出た時 If tbTuki < 1 Or 12 < tbTuki Then MsgBox "1〜12 の数字を入力してください", , "カレンダー" Cancel = True End If End Sub Private Sub UserForm_Initialize() '初期画面の設定 Togetsu = Date Call DaySet End Sub Private Sub DaySet() '1ヶ月分の日を画面に設定 'Dim StartYobi As Integer 'Dim Tuitachi As Date Dim Matubi As Integer Dim i As Integer tbNen = Year(Togetsu) tbTuki = Month(Togetsu) Tuitachi = CDate(tbNen & "/" & tbTuki & "/01") StartYobi = YobiKeisan2(Tuitachi) Matubi = Day(DateAdd("d", -1, DateAdd("m", 1, Tuitachi))) For i = 1 To StartYobi - 1 Me("TextBox" & i).Visible = False Next i For i = StartYobi To StartYobi + Matubi - 1 Me("TextBox" & i).Visible = True Me("TextBox" & i) = i - StartYobi + 1 If Me("TextBox" & i) < 10 Then Me("TextBox" & i) = " " & Me("TextBox" & i) End If Next i For i = Matubi + StartYobi To 37 Me("TextBox" & i).Visible = False Next i Call HolidaysSet End Sub Private Sub HolidaysSet() '祝休日のセット Dim Holiday As Integer Dim i As Integer '一旦すべての日の文字色を黒に戻し、説明文を消す For i = 1 To 37 Me("TextBox" & i).ForeColor = Black Me("TextBox" & i).ControlTipText = "" Next i '日曜の文字色を赤にする For i = 1 To 36 Step 7 Me("TextBox" & i).ForeColor = Red Next i '土曜の文字色を青にする For i = 7 To 35 Step 7 Me("TextBox" & i).ForeColor = Blue Next i '1990年以降の休日設定しか、しない If tbNen < 1990 Then Exit Sub Select Case tbTuki Case 1 Call RedSet(1, "元日") Holiday = GetMonday(Tuitachi, 2) '第2月曜を計算 Call RedSet(Holiday, "成人の日") Case 2 Call RedSet(11, "建国記念の日") Case 3 Holiday = Shunbun2(tbNen) '春分の日の計算 Call RedSet(Holiday, "春分の日") Case 4 Call RedSet(29, "みどりの日") Case 5 Call RedSet(3, "憲法記念日") Call RedSet(4, "国民の休日") Call RedSet(5, "こどもの日") Case 7 Call RedSet(20, "海の日") Case 9 If tbNen < 2003 Then Call RedSet(15, "敬老の日") Else '2003年から第3月曜 Holiday = GetMonday(Tuitachi, 3) Call RedSet(Holiday, "敬老の日") End If Holiday = Shubun2(tbNen) '秋分の日の計算 Call RedSet(Holiday, "秋分の日") Case 10 Holiday = GetMonday(Tuitachi, 2) '第2月曜を計算 Call RedSet(Holiday, "体育の日") Case 11 Call RedSet(3, "文化の日") Call RedSet(23, "勤労感謝の日") Case 12 Call RedSet(23, "天皇誕生日") End Select End Sub Private Sub RedSet(hi As Integer, Setsumei As String) '文字色を赤にする Dim Idx As Integer Idx = StartYobi + hi - 1 Me("TextBox" & Idx).ControlTipText = Setsumei Me("TextBox" & Idx).ForeColor = Red If Idx Mod 7 = 1 Then '休日が日曜日なら、休日振替で翌日を休日とする Idx = Idx + 1 Me("TextBox" & Idx).ControlTipText = Setsumei & "の振替" Me("TextBox" & Idx).ForeColor = Red End If End Sub