職場で掃除チェック表として年間カレンダーを作っているのですが、当然年によって曜日がずれるため毎年作り直しです。
年に１回の作業ですがめんどくさいのでVBAで自動化です。ついでに月間カレンダーも作ってしまいます。
成果物はこちらからダウンロードしてください。
使い方
縦A3で印刷できるサイズの年間カレンダーです。
年度ごとの作成を想定し４月始まりです。
カレンダーの各日付にはチェック欄を設けています。
月間カレンダーも各シートに作成します。
年間シートの実行ボタンからマクロ実行。
入力ボックスが出てくるので何年度のものを作成するか西暦４桁を入力するだけで作成されます。
VBA
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
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 '１ヶ月分の日付を入力' 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で割り切れない → 平年
コメント