【Excel VBA】4月始まりの年間カレンダーを自動作成

職場で掃除のチェック表として年間カレンダーを作っているのですが、年によって曜日がずれるため毎年作り直しです。

年に1回の作業ですがめんどくさいのでVBAで自動化です。ついでに月間カレンダーも作ってしまいます。

スポンサーリンク

プログラムの内容

こちらがサンプルのデータです。

https://www.iehohs.com/files/excel-auto-calendar.zip

縦A3で印刷できるサイズの年間カレンダーです。

年度ごとの作成を想定し4月始まりです。

カレンダーの各日付にはチェック欄を設けています。

月間カレンダーも各シートに作成します。

年間シートの実行ボタンからマクロ実行。

入力ボックスが出てくるので何年度のものを作成するか西暦4桁を入力するだけで作成されます。

プログラミング

VBA

Sub カレンダー作成()
    Dim thisYear As Variant
    Dim nextYear As Variant
    Dim firstDay As Integer
    Dim days As Integer
    Dim row As Integer
    Dim col As Integer
    Dim febFlg As Boolean
    '年度のカレンダーを作成するか入力
    thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
    'キャンセル時の処理
    If thisYear = False Then
        Exit Sub
    End If
    '4桁でない場合の処理
    If Len(thisYear) <> 4 Then
        MsgBox ("西暦は4桁で入力してください。" _
            & vbCrLf & "作業を中止します。")
        Exit Sub
    End If
    '次年度分の変数を用意
    nextYear = thisYear + 1
    '年間カレンダーの中身をリセットする
    For i = 3 To 48 Step 15
       Range(Cells(i, 1), Cells(i + 11, 23)).ClearContents
    Next
    '月間カレンダー各シートの中身をリセットする
    For i = 2 To 13
         Sheets(i).Range("A3:G14").ClearContents
    Next
    '年を入力
    Range("A1").Value = thisYear & "年"
    Range("A46").Value = nextYear & "年"
    '4月1日の曜日を取得、最初に入力する列を決定
    firstDay = Weekday(thisYear + "/04/01")
    col = firstDay
    '年間カレンダーを作成
    For i = 1 To 46 Step 15
        For j = 7 To 23 Step 8
            row = i + 2
            '各月の日数を算出
            Select Case Cells(i, j).Value
                Case "4月", "6月", "9月", "11月"
                    days = 30
                Case "2月"
                    febFlg = False
                    '2月の場合は閏年を判定
                    If nextYear Mod 400 <> 0 Then
                        If nextYear Mod 100 = 0 Then
                             days = 28
                        ElseIf nextYear Mod 4 = 0 Then
                            days = 29
                            febFlg = True
                        Else
                            days = 28
                        End If
                    Else
                        days = 29
                        febFlg = True
                    End If
                Case Else
                    days = 31
            End Select
            '1ヶ月分の日付を入力
            For k = 1 To days
                Cells(row, col).Value = k
                If col = j Then
                    row = row + 2
                    col = j - 6
                Else
                     col = col + 1
                End If
                If k = days Then
                    If j = 23 Then
                        col = col - 16
                    Else
                        col = col + 8
                    End If
                 End If
             Next k
        Next j
    Next i
    '月間カレンダーを作成
    col = firstDay
    For i = 2 To 13
        With Sheets(i)
            '年を入力
            If i >= 11 Then
                .Range("F1").Value = nextYear & "年"
            Else
                .Range("F1").Value = thisYear & "年"
            End If
            '各月の日数を算出
            Select Case i
                Case 2, 4, 7, 9
                    days = 30
                Case 12
                    If febFlg = True Then
                        days = 29
                    Else
                        days = 28
                    End If
                Case Else
                    days = 31
            End Select
            row = 3
            '各シートに1ヶ月分の日付を入力
            For j = 1 To days
                .Cells(row, col).Value = j
                If col = 7 Then
                    row = row + 2
                    col = 1
                Else
                    col = col + 1
                End If
                If j = days Then
                    row = 3
                End If
            Next j
        End With
    Next i
End Sub

閏年の計算方法

閏年の計算方法は、入力された西暦に以下の計算をして、平年であれば28日、閏年であれば29日分の日付を入力するようにしています。

  • 400で割り切れる → 閏年
  • 400で割り切れない and 100で割り切れる → 平年
  • 100で割り切れない and 4で割り切れる → 閏年
  • 4で割り切れない → 平年

コメント

コメントする前にお読みください

プログラミングに関する質問について、詳細なコードはお答えしませんのでご了承ください。
また、迷惑コメント防止のために初回のコメント投稿は承認制です。投稿が反映されるまで少し時間がかかります。