月間カレンダー、祝日あり

記事「祝日を年間カレンダーに追加する 」で作った
年間カレンダーを使って
月間カレンダーを作ります。

2010年分の年間カレンダーなら
「2010年カレンダー」というシート名になっていると思います。
このシートがないと下のコードはエラーになります。

少し長いコードなので
大体の説明だけします。

年間シートの日付けを上から順に
月間カレンダーにしていきます。

まず、月ごとにシートを挿入していくのですが
MyMonth と年間シートの日付けの月を比べて
等しくなかったらシートを挿入します。
シートを挿入したら
月、年、曜日、日ごとの枠を書きます。

年間シートの日付けは曜日を判定して列を決めて
次の日付けが月曜日なら次の週の行に移ります。

細かいことは、下のコードを標準モジュールにコピペして
知りたいプロパティなどにカーソルを持っていって
[F1]キーを押せば、
VBAヘルプの該当ページが開きますのでそれを見てください。

コードはこちら

Sub macro100324a()
'月間カレンダー
'1シートひと月

    Dim i, j, k As Integer
    Dim MyYear, MyMonth As Integer
    MyYear = 2010
    MyMonth = 0
    Dim SheetA, SheetB As Object
    Set SheetA = Sheets(MyYear & "年カレンダー")
    Dim MyRange As Range
    Dim StrWeekDay As Variant
    StrWeekDay = Array("月", "火", "水", "木", "金", "土", "日")
    Dim EndRow, MRow, MCol As Integer
    EndRow = SheetA.Range("A1").End(xlDown).Row
   
    For i = 2 To EndRow
        '月が替わったらシートを挿入
        If MyMonth <> Month(SheetA.Cells(i, 1)) Then
            MyMonth = Month(SheetA.Cells(i, 1))
            SheetAddDel (MyYear & "年" & MyMonth & "月")
            Set SheetB = Sheets(MyYear & "年" & MyMonth & "月")
            
            'なんとなくページ設定
            'まだよくわかってないけど
            With SheetB.PageSetup
                .PrintArea = "$A$1:$G$37"
                .Zoom = False
                .CenterHorizontally = True
                .PaperSize = xlPaperA4
                .FitToPagesTall = 1
                .FitToPagesWide = 1
            End With

            SheetB.Cells(1, 1) = MyMonth & "月"
            SheetB.Cells(1, 1).Font.Size = 24
            
            SheetB.Cells(1, 7) = MyYear & "年"
            SheetB.Cells(1, 7).Font.Size = 16
            
            For j = 1 To 7
                '曜日の文字を入れる
                Cells(2, j) = StrWeekDay(j - 1)
               
                '日ごとの枠を設定、6週分(固定)
                For k = 3 To 3 + 5 * 6 Step 5
                    Set MyRange = Range(toA1("R" & k & "C" & j & ":R" & k + 4 & "C" & j))
                    With MyRange.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With MyRange.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With MyRange.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With MyRange.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                Next k
            Next j
            
            '曜日の文字を中央、そのほかを左揃えなど
            Range("A2:G2").HorizontalAlignment = xlCenter
            Range("A2:G2").RowHeight = 25
            With Range("A3:G37")
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlBottom
                .ColumnWidth = 11.25
            End With
            
            MRow = 3
        End If

        '曜日を判定して列を決める
        If Weekday(SheetA.Cells(i, 1)) = 1 Then
            MCol = 7
        Else
            MCol = Weekday(SheetA.Cells(i, 1)) - 1
        End If
       
        '年間カレンダーの日付けと祝日をSheetBのセルに入れる
        SheetB.Cells(MRow, MCol) = _
            Day(SheetA.Cells(i, 1)) & " " & SheetA.Cells(i, 2)
            
        '日付け文字スタイル
        With SheetB.Cells(MRow, MCol).Characters _
            (start:=1, Length:=Len(Day(SheetA.Cells(i, 1)))).Font
            .Name = "ＭＳ Ｐゴシック"
            .FontStyle = "標準"
            .Size = 17
            .ColorIndex = xlAutomatic
        End With
        '祝日の文字スタイル
        With SheetB.Cells(MRow, MCol).Characters _
            (start:=Len(Day(SheetA.Cells(i, 1))) + 2, _
            Length:=Len(SheetA.Cells(i, 2))).Font
            .Name = "ＭＳ Ｐゴシック"
            .FontStyle = "標準"
            .Size = 11
            .Subscript = True '下付き文字
            .ColorIndex = xlAutomatic
        End With
        'セルの塗りつぶし
        SheetB.Range(toA1("R" & MRow & "C" & MCol & ":R" & MRow + 4 & "C" & MCol)). _
            Interior.Color = SheetA.Cells(i, 1).Interior.Color
        If Weekday(SheetA.Cells(i + 1, 1)) = 2 Then
            MRow = MRow + 5
        End If
    Next i
End Sub

macro100324aを実行後のシートの一部(倍率50%)

祝日がある場合のセル

細かいとこはまだまだテキトーですが、
とりあえず月間カレンダーです。