Excelで西暦を入力するだけで4月始まりの年間&月間カレンダーを作成するマクロです。
職場の掃除チェック用に年間のカレンダーを作っていたのですが、これがまためんどくさかったので作っちゃいました。
ついでに月間のカレンダーも各シートに作成してくれます。予定を書き込んで人に配布するなどに使えるかと(最新のExcelなら新規作成の画面で月間カレンダーのテンプレが選べるみたい)
Contents
Excelデータ
マクロを使用したブックのため、ネットから入手したファイル云々とかいろいろ警告が出ますが気にしないでマクロを有効にしてください。
スクリーンショット

年間のカレンダーを自動作成します。縦A3で印刷できるようにしています。
各日付にチェック欄を設けています。

さらに各シートに月間カレンダーを作成します。空欄はちょっとしたメモができると思います。

マクロは年間シートの実行ボタンから可能。
入力ボックスが出てくるので何年度のものを作成するか西暦4桁を入力してOKを押すと自動作成します。
Macだとなぜかメッセージが表示されませんが、本来は「西暦を半角4桁の数字で入力してください。」と出てきます。
VBA
流れ的には西暦を入力したらその年の4月1日の曜日を取得し、どの列からスタートするかを決定、あとは順番に日付を入力していきます。
Sub autoCalendar()
Dim thisYear As String
Dim nextYear As String
Dim firstDay As Long
Dim days As Long
Dim row As Long
Dim col As Long
Dim febFlg As Boolean
'年度のカレンダーを作成するか入力'
thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
If thisYear = False Then
MsgBox ("キャンセルが押されました。" _
& vbCrLf & "作業を中止します。")
Exit Sub
End If
If Not 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
If Cells(i, j).Value = "4月" Or Cells(i, j).Value = "6月" Or Cells(i, j).Value = "9月" Or Cells(i, j).Value = "11月" Then
days = 30
ElseIf Cells(i, j).Value = "2月" Then
febFlg = False
'閏年を判定'
If Not 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
Else
days = 31
End If
'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
Next
Next
'月間カレンダーを作成'
col = firstDay
For i = 2 To 13
If i >= 11 Then
Sheets(i).Range("F1").Value = nextYear + "年"
Else
Sheets(i).Range("F1").Value = thisYear + "年"
End If
If i = 2 Or i = 4 Or i = 7 Or i = 9 Then
days = 30
ElseIf i = 12 Then
If febFlg = True Then
days = 29
Else
days = 28
End If
Else
days = 31
End If
row = 3
'各シートに1ヶ月分の日付を入力'
For j = 1 To days
Sheets(i).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
Next
End Sub
閏年の計算方法
このマクロで最も重要なのは閏年の計算方法。
入力された西暦に以下の計算をして、平年であれば28日、閏年であれば29日分の日付を入力するようにしています。
- 400で割り切れる → 閏年
- 400で割り切れない and 100で割り切れる → 平年
- 100で割り切れない and 4で割り切れる → 閏年
- 4で割り切れない → 平年