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

やること

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

事前確認：Qiitaでの記事

　ここで、以下の検索をしたところ、13件ヒットした。(2024/07/14時点)
「title:EXCEL,カレンダー」の検索結果 - Qiita

　以下、３つにまとめる。

EXCELの関数など、シート上で作成

【Excel】Excel でカレンダーを作ってみる #Mac - Qiita
投稿日 2018年05月24日

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

Excelでカレンダー作り ##excel関数 - Qiita
投稿日 2021年12月11日

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

Excelで〇日を含む週からスタートするカレンダーを作る #Excel関数 - Qiita
最終更新日 2023年11月09日　投稿日 2023年11月09日

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

Excelに自動更新される祝日カレンダーを追加する（営業日計算用） #PowerQuery - Qiita
投稿日 2023年12月17日

• 内閣府ホームページにある「国民の祝日.csv」を利用する
  https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv
• PowerQueryを利用して、テーブルデータとして取得する

Excelでカレンダーを作ってみる #VBA - Qiita
最終更新日 2018年05月30日　投稿日 2018年05月30日

【Excel】Excel でカレンダーを作ってみるを見たからではないのですが、
実は、カレンダーに年月指定で、出荷状況を表示する機能を作っていました。

Excel VBA 奮闘記 カレンダー(Write Only Code) #VBA - Qiita
投稿日 2014年07月12日

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

カレンダーフォーム

Excel カレンダーフォーム　奮闘記 #VBA - Qiita
最終更新日 2020年06月01日　投稿日 2020年06月01日

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

その他

神Excelの神カレンダー(?)から日付を導く #PowerBI - Qiita
投稿日 2020年05月17日

Excelの入力規則でつくる食卓カレンダー #Excel - Qiita
最終更新日 2018年12月10日　投稿日 2018年12月10日

Power Automate: カレンダーのように列名が変化するExcelテーブルからの取得 #JSON - Qiita
最終更新日 2022年02月19日　投稿日 2021年09月01日

Excel上のカレンダーをGoogleカレンダーで共有する #CSV - Qiita
最終更新日 2019年09月12日　投稿日 2019年09月12日

自作カレンダーにGoogleカレンダーのデータを一瞬で反映させる方法　(Googleカレンダー→GAS→スプレッドシート→EXCEL) #Excel - Qiita
最終更新日 2019年12月12日　投稿日 2019年12月03日

Rを使ってExcelシートの年間予定表をGoogleカレンダーに登録する #CSV - Qiita
最終更新日 2021年12月30日　投稿日 2021年12月21日

今回のメモ

　 Excel VBA 奮闘記 カレンダー(Write Only Code) #VBA - Qiitaを試す際、以下の修正。

'    Set tmp = Worksheets(Me.name).Range("A1")
    Set tmp = Worksheets("Sheet1").Range("A1") ' シート名を指定

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

Sub a()
 Call main
End Sub

Excelに自動更新される祝日カレンダーを追加する（営業日計算用） #PowerQuery - Qiitaで紹介されているものをシート「祝日」として利用。

該当ファイル

カレンダー.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