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()
'１ヶ月分の日を画面に設定

    '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) '第２月曜を計算
        Call RedSet(Holiday, "成人の日")
      Case 2
        Call RedSet(11, "建国記念の日")
      Case 3
        Holiday = Shunbun(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年から第３月曜
            Holiday = GetMonday(Tuitachi, 3)
            Call RedSet(Holiday, "敬老の日")
        End If
        Holiday = Shubun(tbNen)          '秋分の日の計算
        Call RedSet(Holiday, "秋分の日")
      Case 10
        Holiday = GetMonday(Tuitachi, 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