やること
【EXCEL】カレンダーづくり(Write Only Code) #初心者 - Qiitaで1か月のカレンダーを作成したが、今回は3か月カレンダーと1年カレンダーを追加する。
該当ファイル
【EXCEL】数式を保護する #Excel - Qiitaで少し書き直したものをベースに作成。
メイン部分
今回、以下３つを読み出し、若干体裁を整えている部分。
- 1か月のカレンダー
- 3か月カレンダー
- 1年カレンダー
main
Attribute VB_Name = "標準カレンダー"
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 一ヶ月カレ
Call ロック数式セル
ws.Name = "①壱ヶ月カレンダー"
Range("B3").Select ' 年にカーソル移動
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
.Zoom = 80
End With
Sheets.Add After:=ws
Set ws = ActiveSheet ' ws.Name = 追加したシート
Call 三ヶ月カレ
Call ロック数式セル
ws.Name = "②参ヶ月カレンダー"
Range("B3").Select ' 年にカーソル移動
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
.Zoom = 70
End With
Sheets.Add After:=ws
Set ws = ActiveSheet ' ws.Name = 追加したシート
Call 一ヶ年カレ
Call ロック数式セル
ws.Name = "③四ヶ月ｘ三段カレンダー(文字大)"
Range("B3").Select ' 年にカーソル移動
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
.Zoom = 40
End With
End Sub
祝日シートの追加
前回同様、内閣府が公開している祝日CSVデータを利用。
【EXCEL】ExcelAPIのメモ #ExcelVBA - Qiitaで紹介した様な方法もあるが、個人的な休みとかも入れる場合があり、このやり方ばかり。
祝日シート追加
Sub 祝日シート追加()
'------------------------------------------------------------------
' 関数: 祝日シート追加
' 説明: 内閣府が公開している祝日CSVデータをExcelにインポートし、
' 祝日データの列は「holiday_j」として名前定義され、
' 「祝日」シートとしてブック内の末尾に追加される。
' ブック内に追加するため、事前に以下の設定が必要。
' Set wb = ActiveWorkbook
' Set ws = ActiveSheet
' 引数:
' なし
' 戻り値:
' なし
'
' 使用例:
' ' アクティブブックに祝日シートを追加する
' Call 祝日シート追加
'
' 補足: (2025/06/15 時点)
' 国民の祝日について -内閣府
' https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
' 昭和30年（1955年）から令和8年（2026年）国民の祝日（csv形式：20KB）
' 【フォーマット】
' 国民の祝日・休日月日,国民の祝日・休日名称
' 1955/1/1,元日
' ：
'------------------------------------------------------------------
Dim URL_data As String ' 祝日データのURL用
URL_data = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"
Workbooks.Open URL_data ' 祝日データをEXCELで開く
Rows("1:1").Delete Shift:=xlUp ' 1行目のテキスト削除
Columns("A:A").NumberFormatLocal = "[$-x-sysdate]dddd, mmmm dd, yyyy"
ActiveWorkbook.Names.Add Name:="holiday_j", RefersTo:="=syukujitsu!$A:$A"
Sheets("syukujitsu").Move After:=wb.Worksheets(wb.Worksheets.Count)
ActiveSheet.Name = "祝日" ' シート名を変更
wb.Activate ' Moveでwbのみだが念の為実施
ws.Activate ' 最初のシートを表示
End Sub
一ヶ月カレンダーシート
これは過去紹介したものから大きな変化なし。
一ヶ月カレ
Sub 一ヶ月カレ()
'------------------------------------------------------------------
' 関数: 一ヶ月カレ
' 説明: シート名をタイトルにした日曜始まりのカレンダー。
' 3行目に年、月を入力して使用。 (defaultは現在の年月)
' 祝日は名前「holiday_j」を使用。
' 現在のシート名を変更して作成するため、事前に以下の設定が必要。
' Set ws = ActiveSheet
' 引数:
' なし
' 戻り値:
' なし
'
' 使用例:
' ' アクティブブックに一ヶ月カレンダーシートを追加する
' Call 一ヶ月カレ
'------------------------------------------------------------------
ws.Name = "壱ヶ月カレンダー"
'-----セル全体の設定-----
Cells.Select
Call セル設定(11.89, 96#, 255, 255, 255)
Call 文字設定_角POP(11, "黒", "中央")
'-----各行の設定-----
' タイトル
Rows("1:1").Select
Call セル設定(11.89, 30#, 255, 255, 255)
Range("A1:G1").Select
Call 文字設定_角POP(22, "黒", "中")
Cells(1, 1) = "=RIGHT(@CELL(""filename"",A1),LEN(@CELL(""filename"",A1))-FIND(""]"",@CELL(""filename"",A1)))"
' 空行
Rows("2:2").Select
Call セル設定(11.89, 13.2, 255, 255, 255)
' 年月入力
Rows("3:3").Select
Call セル設定(11.89, 21#, 255, 255, 255)
Union(ws.Range("B3"), ws.Range("D3")).Select
Call セル設定(11.89, 21#, 255, 255, 204) ' 可変部分のみ背景色替え
Call 文字設定_角POP(18, "黒", "右") ' 可変部分は右寄せ
Union(ws.Range("C3"), ws.Range("E3")).Select
Call 文字設定_角POP(18, "黒", "左")
Range("G3").Select
Call 文字設定_角POP(18, "白", "左") ' 隠し文字
Range("B3:G3").Formula = Array(Format(Date, "yyyy"), "年", Format(Date, "mm"), "月", "", "=DATE(RC[-5],RC[-3],1)")
' 空行
Rows("4:4").Select
Call セル設定(11.89, 13.2, 255, 255, 255)
' 曜日
Rows("5:5").Select
Call セル設定(11.89, 22.2, 255, 255, 255)
Range("A5").Select
Call 文字設定_角POP(18, "赤", "中央")
Range("B5:F5").Select
Call 文字設定_角POP(18, "黒", "中央")
Range("G5").Select
Call 文字設定_角POP(18, "青", "中央")
Range("A5:G5").Formula = Array("日", "月", "火", "水", "木", "金", "土")
' 日付欄
Dim i As Byte
Dim j As Byte
For i = 6 To 11 ' 6行目から11行目
If i = 6 Then ' セルA6のみ例外処理
Application.ReferenceStyle = xlR1C1
Cells(6, 1).NumberFormatLocal = "d"
Cells(6, 1) = "=R[-3]C[6]-WEEKDAY(R[-3]C[6])+1"
Application.ReferenceStyle = xlA1
Else
Application.ReferenceStyle = xlR1C1
Cells(i, 1).NumberFormatLocal = "d"
Cells(i, 1) = "=R[-1]C[6]+1"
Application.ReferenceStyle = xlA1
End If
For j = 2 To 7 ' B列からG列まで
Application.ReferenceStyle = xlR1C1
Cells(i, j).NumberFormatLocal = "d"
Cells(i, j) = "=RC[-1]+1" ' 左の列+1
Application.ReferenceStyle = xlA1
Next j
Next i
'-----条件付き書式設定 の ルール設定-----
Cells.FormatConditions.Delete
Range("A6:G11").Select
' 条件設定① 今月以外を「白」
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MONTH(A6)<>$D$3"
Selection.FormatConditions(1).Font.Color = RGB(255, 255, 255)
' 条件設定② 祝日を「赤」
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(holiday_j,A6)>0"
Selection.FormatConditions(2).Font.Color = RGB(255, 0, 0)
' 条件設定③ 日曜日を「赤」
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(A6)=1"
Selection.FormatConditions(3).Font.Color = RGB(255, 0, 0)
Selection.FormatConditions(3).StopIfTrue = False
' 条件設定④ 土曜日を「青」
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(A6)=7"
Selection.FormatConditions(4).Font.Color = RGB(0, 0, 255)
Selection.FormatConditions(4).StopIfTrue = False
'-----罫線設定-----
Range("A6:G11").Borders.LineStyle = xlContinuous
End Sub
三ヶ月カレンダーシート
「一ヶ月カレ」をコピーして並べただけ。その際、条件付き書式の修正が必要となる点が注意点。
三ヶ月カレ
Sub 三ヶ月カレ()
'------------------------------------------------------------------
' 関数: 三ヶ月カレ
' 説明: シート名をタイトルにした日曜始まりの三ヶ月分カレンダー。
' 3行目に年、月を入力して使用。 (defaultは現在の年月)
' 祝日は名前「holiday_j」を使用。
' 現在のシート名を変更して作成するため、事前に以下の設定が必要。
' Set ws = ActiveSheet
' また、「一ヶ月カレ」を使用するので、シート名の重複に注意。
' 引数:
' なし
' 戻り値:
' なし
'
' 使用例:
' ' アクティブブックに三ヶ月カレンダーシートを追加する
' Call 三ヶ月カレ
'------------------------------------------------------------------
Call 一ヶ月カレ
' (始)一ヶ月カレンダーのフォーマット変更
ws.Name = "参ヶ月カレンダー"
Range("A5:G5").Borders.LineStyle = xlContinuous ' 曜日欄も枠線追加
Range("A5:G5").Borders(xlEdgeBottom).LineStyle = xlDouble ' 曜日欄の下は2本線
With Range("A5:G11") ' 一か月分の外枠を太く
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
' (終)一ヶ月カレンダーのフォーマット変更
' (始)＋１
Range("A3:G11").Copy Destination:=Range("H3") ' +1月分
Cells(3, 14) = "=DATE(RC[-12],RC[-10]+1,1)" ' N3を左隣の月+1
Range("I3").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' N3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("K3").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' N3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Call 条件付き書式の書換(Range("H6:N11"), "$K$3")
' (終)＋１
' (始)＋１＋１
Range("H3:N11").Copy Destination:=Range("O3") ' +1月分+1月分
Cells(3, 21) = "=DATE(RC[-12],RC[-10]+1,1)" ' O3を左隣の月+1
Range("P3").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' O3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("R3").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' O3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Call 条件付き書式の書換(Range("O6:U11"), "$R$3")
' (終)＋１＋１
End Sub
一年分カレンダーシート
「三ヶ月カレ」同様、「一ヶ月カレ」をコピーして並べただけ。その際、条件付き書式の修正が必要となるが、最後にまとめて実施。
一ヶ年カレ
Sub 一ヶ年カレ()
'------------------------------------------------------------------
' 関数: 一ヶ年カレ
' 説明: シート名をタイトルにした日曜始まりの一年分(4ヶ月×3段)カレンダー
' 3行目に年、月を入力して使用 (defaultは現在の年月)
' 祝日は名前「holiday_j」を使用
' 現在のシート名を変更して作成するため、事前に以下の設定が必要。
' Set ws = ActiveSheet
' また、「一ヶ月カレ」を使用するので、シート名の重複に注意。
' 引数:
' なし
' 戻り値:
' なし
'
' 使用例:
' ' アクティブブックに一年分カレンダーシートを追加する
' Call 一ヶ年カレ
'------------------------------------------------------------------
Call 一ヶ月カレ
' (始)一ヶ月カレンダーのフォーマット変更
ws.Name = "四ヶ月ｘ三段カレンダー(文字大)"
Range("A5:G5").Borders.LineStyle = xlContinuous ' 曜日欄も枠線追加
Range("A5:G5").Borders(xlEdgeBottom).LineStyle = xlDouble ' 曜日欄の下は2本線
With Range("A5:G11") ' 一か月分の外枠を太く
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Font.Size = 18 ' 文字サイズを11→18
End With
' (終)一ヶ月カレンダーのフォーマット変更
Range("A3:G11").Copy Destination:=Range("H3") ' +1月分
Cells(3, 14) = "=DATE(RC[-12],RC[-10]+1,1)" ' N3を左隣の月+1
Range("I3").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' N3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("K3").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' N3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Call 条件付き書式の書換(Range("H6:N11"), "$K$3")
' (終)＋１
' (始)＋１＋１
Range("H3:N11").Copy Destination:=Range("O3") ' +1月分+1月分
Cells(3, 21) = "=DATE(RC[-12],RC[-10]+1,1)" ' O3を左隣の月+1
Range("P3").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' O3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("R3").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' O3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Call 条件付き書式の書換(Range("O6:U11"), "$R$3")
' (終)＋１＋１
' (始)＋１＋１＋１
Range("O3:U11").Copy Destination:=Range("V3") ' +1月分+1月分+1月分
Cells(3, 28) = "=DATE(RC[-12],RC[-10]+1,1)" ' W3を左隣の月+1
Range("W3").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' W3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("Y3").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' W3より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Call 条件付き書式の書換(Range("V6:AB11"), "$Y$3")
' (終)＋１＋１＋１
' 2段目
Rows("1:11").Copy Destination:=Range("A12")
Cells(14, 7) = "=DATE(R[-11]C[16],R[-11]C[18]+1,1)" ' G14を右上の月+1
Range("B14").Select ' 年
Selection.Value = "=YEAR(RC[5])" ' G14より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("D14").Select ' 月
Selection.Value = "=MONTH(RC[3])" ' G14より
Call セル設定(11.89, 21#, 255, 255, 255) ' 可変部分の色替え
Range("A12").Value = "" ' シート名
Call 条件付き書式の書換(Range("A17:G22"), "$D$14")
Call 条件付き書式の書換(Range("H17:N22"), "$K$14")
Call 条件付き書式の書換(Range("O17:U22"), "$R$14")
Call 条件付き書式の書換(Range("V17:AB22"), "$Y$14")
' 3段目
Rows("12:22").Copy Destination:=Range("A23")
Call 条件付き書式の書換(Range("A28:G33"), "$D$25")
Call 条件付き書式の書換(Range("H28:N33"), "$K$25")
Call 条件付き書式の書換(Range("O28:U33"), "$R$25")
Call 条件付き書式の書換(Range("V28:AB33"), "$Y$25")
End Sub
カレンダー部分のロック
【EXCEL】数式を保護する #Excel - Qiita参照。
ロック数式セル
Sub ロック数式セル()
'------------------------------------------------------------------
' 関数: ロック数式セル
' 説明: Excelシート内の数式が含まれているセルのみをロックし、
' シート全体の保護を適用する。
' アクティブシートのみため、事前に以下の設定が必要。
' Set ws = ActiveSheet
' 引数:
' なし
' 戻り値:
' なし
'
' 使用例:
' ' 現在のアクティブシートで数式セルのみをロックする
' Call ロック数式セル()
'------------------------------------------------------------------
Dim 範囲 As Range
Dim セル As Range
ws.Cells.Locked = False ' すべてのセルのロックを解除（初期化）
Set 範囲 = ws.UsedRange ' ワークシートの使用範囲を取得
For Each セル In 範囲 ' 数式を含むセルを検索してロック
If セル.HasFormula Then セル.Locked = True
Next セル
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' ワークシートの保護を適用（パスワードなし）
' MsgBox "数式セルをロックし、シートを保護しました。", vbInformation, "完了"
End Sub
共通関数
前回、辞書型変数に修正した関数と、今回新規に作成したもの。
セル設定
セル設定
Function セル設定(幅 As Single, 高 As Single, 背景R As Byte, 背景G As Byte, 背景B As Byte)
'------------------------------------------------------------------
' 関数: セル設定
' 説明: 指定された列の幅、行の高さ、および背景色を設定する。
' 引数:
' 幅 - 設定する列の幅 (Single型)
' 高 - 設定する行の高さ (Single型)
' 背景R - 背景色の赤成分 (Byte型、0～255)
' 背景G - 背景色の緑成分 (Byte型、0～255)
' 背景B - 背景色の青成分 (Byte型、0～255)
' 戻り値:
' なし
'
' 使用例:
' ' 列幅を11.89, 行の高さを13.2, 背景色を白色に設定
' Call セル設定(11.89, 13.2, 255, 255, 255)
'------------------------------------------------------------------
With Selection
.ColumnWidth = 幅
.RowHeight = 高
.Interior.Color = RGB(背景R, 背景G, 背景B)
End With
End Function
文字設定
文字設定_角POP
Function 文字設定_角POP(サイズ As Single, 文字色 As String, 横位置 As String)
'------------------------------------------------------------------
' 関数: 文字設定_角POP
' 説明: 指定されたフォントサイズ・文字色・横位置に基づいて、
' 選択範囲の文字のフォント設定を変更する。
' 引数:
' サイズ - 設定するフォントサイズ (Single型)
' 文字色 - 変更する文字色 ("黒"、"白"、"赤"、"緑"、"青"、"水"、"紫"、"黄" など)
' 横位置 - 水平方向の文字揃え ("左"、"中央"、"中"、"右" など)
' 戻り値:
' なし
'
' 使用例:
' ' 文字サイズを18pt、文字色を「赤」、横位置を「中央」に設定する
' Call 文字設定_角POP(18, "赤", "中央")
'------------------------------------------------------------------
Dim 色辞書 As Object, 位置辞書 As Object
Set 色辞書 = CreateObject("Scripting.Dictionary")
Set 位置辞書 = CreateObject("Scripting.Dictionary")
' 文字色のRGB定義
色辞書.Add "黒", RGB(0, 0, 0)
色辞書.Add "白", RGB(255, 255, 255)
色辞書.Add "赤", RGB(255, 0, 0)
色辞書.Add "緑", RGB(0, 255, 0)
色辞書.Add "青", RGB(0, 0, 255)
色辞書.Add "水", RGB(0, 255, 255)
色辞書.Add "紫", RGB(255, 0, 255)
色辞書.Add "黄", RGB(255, 255, 0)
' 横位置の定義
位置辞書.Add "左", xlLeft
位置辞書.Add "中央", xlCenter
位置辞書.Add "中", xlCenterAcrossSelection
位置辞書.Add "右", xlRight
' 設定適用
With Selection
.Font.Name = "HGP創英角ﾎﾟｯﾌﾟ体"
.Font.FontStyle = "標準"
.Font.Size = サイズ
.Font.Color = IIf(色辞書.Exists(文字色), 色辞書(文字色), RGB(16, 16, 16))
.VerticalAlignment = xlGeneral
.HorizontalAlignment = IIf(位置辞書.Exists(横位置), 位置辞書(横位置), xlGeneral)
End With
End Function
条件付き書式の書換
条件付き書式の書換
Sub 条件付き書式の書換(範囲 As Range, 基準日 As String)
'------------------------------------------------------------------
' 関数: 条件付き書式の書換
' 説明: Copyによって増殖した条件付き書式設定の絶対参照を修正。
' 修正によって順番が変わるのを防ぐため、該当行以外も修正。
' セルの参照アドレスを「相対参照」として取得するため、
' 引数「範囲」に「.Address(False, False)」を指定。
' 引数:
' 範囲 - 条件付き書式を適用する範囲 (Range型)
' 基準日 - 非表示の基準日のセルアドレス (String型, 例: "$D$14")
' 戻り値:
' なし (指定したセル範囲に対して直接条件付き書式を適用)
'
' 使用例:
' ' H6:N11 に対して、$K$3 を参照した条件付き書式を適用する
' Call 条件付き書式の書換(Range("H6:N11"), "$K$3")
'------------------------------------------------------------------
With 範囲
.FormatConditions(1).Modify Type:=xlExpression, Formula1:="=MONTH(" & 範囲.Cells(1, 1).Address(False, False) & ")<>" & 基準日
.FormatConditions(1).Modify Type:=xlExpression, Formula1:="=COUNTIF(holiday_j," & 範囲.Cells(1, 1).Address(False, False) & ")>0"
.FormatConditions(1).Modify Type:=xlExpression, Formula1:="=WEEKDAY(" & 範囲.Cells(1, 1).Address(False, False) & ")=1"
.FormatConditions(4).StopIfTrue = False
.FormatConditions(1).Modify Type:=xlExpression, Formula1:="=WEEKDAY(" & 範囲.Cells(1, 1).Address(False, False) & ")=7"
.FormatConditions(4).StopIfTrue = False
End With
End Sub
結果
以下画面のキャプチャー。
一ヶ月カレンダーシートのキャプチャー
三ヶ月カレンダーシートのキャプチャー
一年分カレンダーシートのキャプチャー
(全体)
