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

# やること
　EXCELでカレンダーを作り、そのファイルをマスターにして使いまわしている。
　今回、その作成手順をVBAで「マクロの記録」の如く残してみる。

# 事前確認：Qiitaでの記事
　ここで、以下の検索をしたところ、13件ヒットした。(2024/07/14時点)
 [「title:EXCEL,カレンダー」の検索結果 - Qiita](https://qiita.com/search?sort=&q=title%3AEXCEL%2C%E3%82%AB%E3%83%AC%E3%83%B3%E3%83%80%E3%83%BC)

　以下、３つにまとめる。
 
## EXCELの関数など、シート上で作成
[【Excel】Excel でカレンダーを作ってみる #Mac - Qiita](https://qiita.com/pitao/items/b81f2cd0bfffe51f5cfa)
投稿日 2018年05月24日

>Excelでカレンダーを作る機会があったので，使いそうな機能をまとまてみる．

[Excelでカレンダー作り ##excel関数 - Qiita](https://qiita.com/shanana/items/5552895803156ec8c117)
投稿日 2021年12月11日

>Excel関数でカレンダーを作ったときのメモ。

[Excelで〇日を含む週からスタートするカレンダーを作る #Excel関数 - Qiita](https://qiita.com/panda7461@github/items/485e49f3020a992c2e38)
最終更新日 2023年11月09日　投稿日 2023年11月09日

>「うちの会社、15日締だから16日の週から始まるカレンダーをExcelで作りたいんだけど」と言われて作ったので備忘録として残して共有します。

[Excelに自動更新される祝日カレンダーを追加する（営業日計算用） #PowerQuery - Qiita](https://qiita.com/Rui010/items/f93ae1d7bc909a637630)
投稿日 2023年12月17日
>* 内閣府ホームページにある「国民の祝日.csv」を利用する
>[https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv](https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv)
>* PowerQueryを利用して、テーブルデータとして取得する


[Excelでカレンダーを作ってみる #VBA - Qiita](https://qiita.com/matumoto_onga/items/65d46f8de63952ce3382)
最終更新日 2018年05月30日　投稿日 2018年05月30日

>[【Excel】Excel でカレンダーを作ってみる](https://qiita.com/taopi/items/b81f2cd0bfffe51f5cfa)を見たからではないのですが、
>実は、カレンダーに年月指定で、出荷状況を表示する機能を作っていました。

[Excel VBA 奮闘記 カレンダー(Write Only Code) #VBA - Qiita](https://qiita.com/ririn_yume/items/95212c9a5cbc8c84f843)
投稿日 2014年07月12日

>ほとんど書捨て(Write Only)に近いけれどカレンダーらしきものを書いた。


## カレンダーフォーム
[Excel カレンダーフォーム　奮闘記 #VBA - Qiita](https://qiita.com/granpa/items/cc54539300c3e3daadba)
最終更新日 2020年06月01日　投稿日 2020年06月01日

>Excelの日付入力をカレンダーフォームの日付クリックで入力したい。
>昔（調べてみると2007までは、標準であったようです。)は出来ていたようなのですが、
>最近は出来なくなったようで、excel calendar form とかで検索するとヒントやダウンロードできるものが
>たくさん見つかりました。

## その他
[神Excelの神カレンダー(?)から日付を導く #PowerBI - Qiita](https://qiita.com/Variablob/items/ed9814b4b51f2bf9adcf)
投稿日 2020年05月17日

[Excelの入力規則でつくる食卓カレンダー #Excel - Qiita](https://qiita.com/filderschoice/items/ed8161342056c6c64b20)
最終更新日 2018年12月10日　投稿日 2018年12月10日

[Power Automate: カレンダーのように列名が変化するExcelテーブルからの取得 #JSON - Qiita](https://qiita.com/baku2san/items/47ed6fbf78f32ccbd927)
最終更新日 2022年02月19日　投稿日 2021年09月01日

[Excel上のカレンダーをGoogleカレンダーで共有する #CSV - Qiita](https://qiita.com/Rin_H/items/c0516833667f320767c3)
最終更新日 2019年09月12日　投稿日 2019年09月12日

[自作カレンダーにGoogleカレンダーのデータを一瞬で反映させる方法　(Googleカレンダー→GAS→スプレッドシート→EXCEL) #Excel - Qiita](https://qiita.com/t-chi/items/669f329f1aba6fba72f4)
最終更新日 2019年12月12日　投稿日 2019年12月03日

[Rを使ってExcelシートの年間予定表をGoogleカレンダーに登録する #CSV - Qiita](https://qiita.com/furichang/items/b1537dc0f44c05769d48)
最終更新日 2021年12月30日　投稿日 2021年12月21日

## 今回のメモ
　 [Excel VBA 奮闘記 カレンダー(Write Only Code) #VBA - Qiita](https://qiita.com/ririn_yume/items/95212c9a5cbc8c84f843)を試す際、以下の修正。
  
```vb
'    Set tmp = Worksheets(Me.name).Range("A1")
    Set tmp = Worksheets("Sheet1").Range("A1") ' シート名を指定
```

また、最後に以下を記載し実施。

```vb
Sub a()
 Call main
End Sub
```
[Excelに自動更新される祝日カレンダーを追加する（営業日計算用） #PowerQuery - Qiita](https://qiita.com/Rui010/items/f93ae1d7bc909a637630)で紹介されているものをシート「祝日」として利用。

## 該当ファイル
```vb:カレンダー.bas 

Attribute VB_Name = "カレンダー"
Option Explicit
Sub main()
    '-----祝日シート追加-----
    ' 内閣府の祝日データを「holiday_j」と定義し、シートの最後に移動
    Dim wb As Workbook                  ' VBAを起動したワークブック用
    Set wb = ActiveWorkbook             ' wb.Name = Book1(初期起動時)
    Dim ws As Worksheet                 ' VBAを起動したワークシート用
    Set ws = ActiveSheet                ' ws.Name = Sheet1(初期起動時)
    Dim URL_data As String              ' 祝日データのURL用
     URL_data = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"
    ' 昭和30年（1955年）から令和7年（2025年）国民の祝日（csv形式：20KB） (2024/07/14時点)
    ' 国民の祝日について - 内閣府 https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
    Workbooks.Open URL_data             ' 祝日データをEXCELで開く
    Rows("1:1").Delete Shift:=xlUp      ' テキスト削除
    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のため新規時には不要
    ws.Activate                         ' 最初のシートを表示
    '-----1か月カレンダー-----
    '3行目に年、月を入力：シート名をタイトルにした日曜始まりのカレンダー
    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)
    Range("B3").Select
        Call セル設定(11.89, 21#, 255, 255, 204)
        Call 文字設定_角POP(18, "黒", "右")
'2024.10.27 年を固定値から作成日に修正
'        ActiveCell.FormulaR1C1 = "2024"
        ActiveCell.FormulaR1C1 = Format(Date, "yyyy")
'2024.10.27 年を固定値から作成日に修正
    Range("C3").Select
        Call 文字設定_角POP(18, "黒", "左")
        ActiveCell.FormulaR1C1 = "年"
    Range("D3").Select
        Call セル設定(11.89, 21#, 255, 255, 204)
        Call 文字設定_角POP(18, "黒", "右")
'2024.10.27 年を固定値から作成日に修正
'        ActiveCell.FormulaR1C1 = "7"
        ActiveCell.FormulaR1C1 = Format(Date, "mm")
'2024.10.27 年を固定値から作成日に修正
    Range("E3").Select
        Call 文字設定_角POP(18, "黒", "左")
        ActiveCell.FormulaR1C1 = "月"
    Range("G3").Select
        Call 文字設定_角POP(18, "白", "左")
        ActiveCell.FormulaR1C1 = "=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, "赤", "中央")
        ActiveCell.FormulaR1C1 = "日"
    Range("B5").Select
        Call 文字設定_角POP(18, "黒", "中央")
        ActiveCell.FormulaR1C1 = "月"
    Range("C5").Select
        Call 文字設定_角POP(18, "黒", "中央")
        ActiveCell.FormulaR1C1 = "火"
    Range("D5").Select
        Call 文字設定_角POP(18, "黒", "中央")
        ActiveCell.FormulaR1C1 = "水"
    Range("E5").Select
        Call 文字設定_角POP(18, "黒", "中央")
        ActiveCell.FormulaR1C1 = "木"
    Range("F5").Select
        Call 文字設定_角POP(18, "黒", "中央")
        ActiveCell.FormulaR1C1 = "金"
    Range("G5").Select
        Call 文字設定_角POP(18, "青", "中央")
        ActiveCell.FormulaR1C1 = "土"
    ' 日付欄
    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


Function セル設定(幅 As Single, 高 As Single, 背景R As Byte, 背景G As Byte, 背景B As Byte)
    With Selection
        .ColumnWidth = 幅
        .RowHeight = 高
        .Interior.Color = RGB(背景R, 背景G, 背景B)
    End With
End Function

Function 文字設定_角POP(サイズ As Single, 文字色 As String, 横位置 As String)
    Dim 文字色R As Byte
    Dim 文字色G As Byte
    Dim 文字色B As Byte
    Select Case 文字色
        Case "黒"
               文字色R = 0
               文字色G = 0
               文字色B = 0
        Case "白"
               文字色R = 255
               文字色G = 255
               文字色B = 255
        Case "赤"
               文字色R = 255
               文字色G = 0
               文字色B = 0
        Case "緑"
               文字色R = 0
               文字色G = 255
               文字色B = 0
        Case "青"
               文字色R = 0
               文字色G = 0
               文字色B = 255
        Case "水"
               文字色R = 0
               文字色G = 255
               文字色B = 255
        Case "紫"
               文字色R = 255
               文字色G = 0
               文字色B = 255
        Case "黄"
               文字色R = 255
               文字色G = 255
               文字色B = 0
        Case Else
               文字色R = 16
               文字色G = 16
               文字色B = 16
    End Select
    Dim 位置 As Integer
    Select Case 横位置
        Case "左"                       ' 左詰め(インデント)
            位置 = xlLeft
        Case "中央"                     ' 中央揃え
            位置 = xlCenter
        Case "中"                       ' 選択範囲内で中央
            位置 = xlCenterAcrossSelection
        Case "右"                       ' 右詰め(インデント)
            位置 = xlRight
        Case Else                       ' xlFill : 繰り返し xlJustify : 両端揃え xlDistributed : 均等割り付け は
            位置 = xlGeneral            ' 標準
    End Select
    With Selection
        .Font.Name = "HGP創英角ﾎﾟｯﾌﾟ体"
        .Font.FontStyle = "標準"
        .Font.Size = サイズ
        .Font.Color = RGB(文字色R, 文字色G, 文字色B)
        .VerticalAlignment = xlGeneral
        .HorizontalAlignment = 位置
    End With
End Function
```
<details><summary>(追記：完成形)</summary>

![20250423_000000.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3838258/6b2169fe-a866-47e0-acfe-c3a2f8d51598.jpeg)

セーブすれば「#VALUE!」のところがシート名になる。(ただし、Pathに”]”があると期待と異なる表示になる:sweat_smile:)

</details>