難易度：★★☆（やや難）

※当校のExcel VBAコースを補足する内容となっています。

【Sample9】カレンダーを作ろう　では、翌月ひと月分のカレンダーを作りました。
今回は、1年分のカレンダーを作りましょう。

1年分、同じシートに並べて作るの？

今回は、ひと月ごとにシートをわけます。

ひと月分の罫線と曜日だけを記載したひな形（テンプレート）となるシートを用意し、そのシートをコピーして、1月から12月のカレンダーとしてみましょう。

ひな形シートをコピーする

まずは、ひな形シートを作りましょう。シート見出しを「Template」とし、[A1]セルには、作りたい年の1月1日の日付を入力します。「セルの書式設定」の「日付の表示形式」を変更して年月のみが表示されるようにしましょう。

また、曜日の見出し（日～土）を入力し、日曜日のセル(A2:A8)には赤の文字色、土曜日のセル（G2:G8）には青の文字色を設定しておきます。

これをコピーして1月のシートを作り、1～月末日付を表示することにします。

2～12月分も同様にTemplateシートをコピーして作ります。



Sub YearCalender()
    Dim Ws As Workshee
    Dim w_date As Date
    Dim i, j, n, x As Long
    Dim sw As Boolean
    Const ix7 = 7
    Const ix8 = 8
    Const ix12 = 12
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If InStr(Ws.Name, "月") > 0 Then Ws.Delete
    Next Ws
    Application.DisplayAlerts = True
    
    w_date = Worksheets("Template").Range("A1")
    x = Weekday(w_date)
    
    For n = 1 To ix12
        Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
        Set Ws = ActiveSheet
        With Ws
            .Cells(1, 1) = w_date
            .Name = Year(w_date) & "年" & Month(w_date) & "月"
            For i = 3 To ix8
                For j = x To ix7
                    .Cells(i, j) = w_date
                    w_date = w_date + 1
                    If Month(.Cells(1, 1)) <> Month(w_date) Then
                        x = Weekday(w_date, vbSunday)
                        If i <> ix8 Then .Rows(ix8).Hidden = True
                        sw = True
                        Exit For
                    End If
                Next j
                If sw = True Then
                    sw = False
                    Exit For
                End If
                x = 1
            Next i
        End With
    Next n
End Sub

【Sample9】カレンダーを作ろう　と比較して違いを調べてみましょう。

祝日を赤色にする

祝日も赤文字で表示したいです。　

成人の日(1月の第2月曜日)や春分の日(3月20～21日頃)など、一部の祝日は年によって日付が変わりますね。

そのために毎年プログラムを変更するのは好ましくありません。

「祝日」シートを作って1年分の祝日を設定し、それをプログラムから参照するようにしましょう。

内閣府のサイト「国民の祝日について」に祝日の記載があります。

その他、振替休日など赤色にしたい日付があれば、リストに追加しましょう。

祝日リスト


Sub YearCalender2()
    Dim Ws As Worksheet
    Dim w_date As Date

    Dim i, j, n, x As Long
    Dim s, s_End As Long
    Dim sw, S_Sw As Boolean
    Dim w_Syukujitu As Variant
    Const ix7 = 7
    Const ix8 = 8
    Const ix12 = 12
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If InStr(Ws.Name, "月") > 0 Then Ws.Delete
    Next Ws
    Application.DisplayAlerts = True
    
    w_date = Worksheets("Template").Range("A1"): x = Weekday(w_date)
    
    With Worksheets("祝日")
        s_End = .Cells(Rows.Count, 1).End(xlUp).Row
        ReDim w_Syukujitu(1 To s_End)
        For s = 1 To s_End
            w_Syukujitu(s) = .Cells(s, 1)
        Next s
    End With
    
    For n = 1 To ix12
        Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
        Set Ws = ActiveSheet
        With Ws
            .Cells(1, 1) = w_date
            .Name = Year(w_date) & "年" & Month(w_date) & "月"
            For i = 3 To ix8
                For j = x To ix7
                    .Cells(i, j) = w_date
                    For s = 1 To s_End
                        If w_date = w_Syukujitu(s) Then
                            .Cells(i, j).Font.Color = RGB(255, 0, 0)
                            Exit For
                        End If
                    Next s
                     w_date = w_date + 1
                    If Month(.Cells(1, 1)) <> Month(w_date) Then
                        x = Weekday(w_date)
                        If i <> ix8 Then .Rows(ix8).Hidden = True
                        sw = True: Exit For
                    End If
                Next j
                If sw = True Then
                    sw = False
                    Exit For
                End If
                x = 1
            Next i
        End With
    Next n
End Sub