【EXCEL】カレンダーづくり：おまけ(Write Only Code)

やること

　【EXCEL】カレンダーづくり(Write Only Code) #初心者 - Qiitaの1か月のカレンダー別バージョン。

該当ファイル

　【EXCEL】カレンダーづくり再び(Write Only Code) #Excel - Qiitaの一部流用しつつ作成。

流用した部分

祝日シートの追加
カレンダー部分のロック

共通関数は未使用

　セル設定、文字設定などを使用していないので、カレンダーの基本形は単体で動きます、たぶん。

メイン部分

main

Attribute VB_Name = "一ヶ月カレ2"
Option Explicit
    Public wb As Workbook               ' VBAを起動したワークブック用
    Public ws As Worksheet              ' VBAを起動したワークシート用


Sub main()
    Set wb = ActiveWorkbook             ' wb.Name = Book1(初期起動時)
    Set ws = ActiveSheet                ' ws.Name = Sheet1(初期起動時)
        Call 祝日シート追加
        Call 一ヶ月カレ2
        Call ロック数式セル
End Sub

1か月のカレンダー(2)

1か月のカレンダー(2)

Sub 一ヶ月カレ2()
'------------------------------------------------------------------
' 関数: 一ヶ月カレ2
' 説明: シート名をタイトルにした月曜始まりのカレンダー
'       A1に日付を入力して使用 (defaultは現在の年月)
'       祝日は名前「holiday_j」を使用。
'   *1  現在のシート名を変更して作成するため、事前に以下の設定が必要。
'   *1      Set ws = ActiveSheet
'   *1  (現在のシート名を変更をコメントアウトすることで単体動作可能)
' 引数:
'   なし
' 戻り値:
'   なし
'
' 使用例:
'   ' アクティブブックに一ヶ月カレンダシートを追加する
'   Call 一ヶ月カレ2
'------------------------------------------------------------------
'    ws.Name = "一ヶ月カレンダー"               ' *1 上記説明参照
    'セル全体(A1:H9)の設定
    Rows("4:9").RowHeight = 102
    Columns("A:H").ColumnWidth = 16.64
    With Range("B3:H9")
        .Font.Name = "Meiryo"
        .Font.Size = 24
        .Font.Bold = True
        .Font.Color = RGB(0, 0, 0)
        .Interior.Color = RGB(255, 255, 255)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.Color = RGB(0, 0, 0)
    End With
    '各行の設定
    ' 日付入力行
    Rows(1).RowHeight = 27                      ' 高さの設定
    With Cells(1, 1)                            ' A1に日付入力
        .NumberFormatLocal = "yyyy年m月d日"
        .Value = DateSerial(Year(Date), Month(Date), 1)
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .Interior.Color = RGB(255, 255, 0)      ' 可変部分のみ背景色替え
    End With
    ' 年の表記
    Rows(2).RowHeight = 15.6
    With Range("A2:B2")
        .Font.Color = RGB(255, 255, 255)        ' 隠し文字
    End With
    Cells(2, 1).Formula = "=YEAR(A1)"
    Cells(2, 2).Formula = "=TEXT(A1, ""ggge年"")"
    Rows(3).RowHeight = 39
    With Cells(3, 1)
        .Font.Size = 14
        .Font.Bold = True
        .Formula = "=CONCAT(A2, CHAR(13), CHAR(10), ""("", B2, "")"")"
        .WrapText = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    ' 月の表記
    With Cells(4, 1)
        .Font.Size = 48
        .Font.Bold = True                   ' 太字
        .Formula = "=MONTH(A1)"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With Cells(5, 1)
        .Font.Size = 18
        .Font.Bold = True                   ' 太字
        .Formula = "=A1"
        .NumberFormatLocal = "mmmm"         ' 英語表記の月のみ表示（例: June）
        .VerticalAlignment = xlTop
        .HorizontalAlignment = xlCenter
        End With
    ' 曜日
    Range("B3:H3").Formula = Array("月", "火", "水", "木", "金", "土", "日")
    With Range("B3:H3")
        .Font.Size = 24
        .Font.Bold = True                   ' 太字
        .Font.Color = RGB(255, 255, 255)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Range("B3:F3").Interior.Color = RGB(191, 191, 191)
    Range("G3").Interior.Color = RGB(0, 0, 192)
    Range("H3").Interior.Color = RGB(255, 0, 0)
    ' 日付欄
    Dim i As Byte
    Dim j As Byte
    For i = 4 To 9
        If i = 4 Then                       ' セルB4のみ例外処理
            Cells(4, 2).NumberFormatLocal = "d"
            Cells(4, 2) = "=$A$1-(WEEKDAY($A$1,2)-1)"
        Else
            Application.ReferenceStyle = xlR1C1
            Cells(i, 2).NumberFormatLocal = "d"
            Cells(i, 2) = "=R[-1]C[6]+1"
            Application.ReferenceStyle = xlA1
        End If
        For j = 3 To 8                      ' C列からH列まで
            Application.ReferenceStyle = xlR1C1
            Cells(i, j).NumberFormatLocal = "d"
            Cells(i, j) = "=RC[-1]+1"
            Application.ReferenceStyle = xlA1
        Next j
    Next i
    '-----条件付き書式設定 の ルール設定-----
    Cells.FormatConditions.Delete
    Range("B4:H9").Select
    ' 条件設定① 今月以外を「白」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MONTH(B4)<>MONTH($A$1)"
    Selection.FormatConditions(1).Font.Color = RGB(217, 217, 217)
    ' 条件設定② 祝日を「赤」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(holiday_j,B4)>0"
    Selection.FormatConditions(2).Font.Color = RGB(255, 0, 0)
    ' 条件設定③ 日曜日を「赤」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(B4)=1"
    Selection.FormatConditions(3).Font.Color = RGB(255, 0, 0)
    Selection.FormatConditions(3).StopIfTrue = False
    ' 条件設定④ 土曜日を「青」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(B4)=7"
    Selection.FormatConditions(4).Font.Color = RGB(0, 112, 192)
    Selection.FormatConditions(4).StopIfTrue = False
    '-----日付設定欄-----
    Cells(1, 1).Select
End Sub

結果

以下画面のキャプチャー。

一ヶ月カレンダーシートのキャプチャー

おまけの説明

　「1回テンプレート化すれば、わざわざVBAで動かす必要ないのでは？」
→はい、おっしゃる通りです。
/* ただ、そのテンプレートを持ち出し忘れた際、ここのマクロを使って再度テンプレート化できるので */