ExcelVBAで祝日つき予定表の作成してみた

ExcelVBAで祝日つき予定表の作成してみた
この動画のマクロはWindows11/Office2013で作成してます。

内閣府　「国民の祝日」について
https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
昭和30年（1955年）から令和5年（2023年）国民の祝日（csv形式：20KB）
https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv

Option Explicit

Sub Macro1()
    Const org_r = 1       ' 横方向
    Const org_c = 2       ' 縦方向
    Const num_box = 2
    Const sUrl = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"
    'その他の変数宣言
    Dim this_year, xShukujitu, ws, ShukujitsuTBL, y, m, d, sLast, sLastDay, cell_date, cell_month, xlookup, x_date
    
   
    ' 今年の年を取得
    this_year = Year(Date)
    
    Application.DisplayAlerts = False ' メッセージを非表示
    ' 今年のシートの作成
    If ExistsSheet(Str(this_year)) Then Sheets(Str(this_year)).Delete
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Str(this_year)
    ' 来年のシートの作成
    If ExistsSheet(Str(this_year + 1)) Then Sheets(Str(this_year + 1)).Delete
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Str(this_year + 1)
    ' 祝日シートの作成
    xShukujitu = "祝日"
    If ExistsSheet(xShukujitu) Then Sheets(xShukujitu).Delete
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = xShukujitu

  
    ' ネット上の祝日データーCSVの読み込み
    Set ws = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sUrl, Destination:=Range(xShukujitu & "!$A$1"))
        ws.TextFilePlatform = 932                               ' Shift_JIS を開く
        ws.TextFileStartRow = 1                                 ' 1 行目から読み込み
        ws.TextFileParseType = xlDelimited                      ' 区切り文字の形式
        ws.TextFileCommaDelimiter = True                        ' カンマ区切り
        ws.TextFileColumnDataTypes = Array(2, 2)                ' データータイプを文字型にする
        
    ws.Refresh BackgroundQuery:=False                           ' CSV取得
    ShukujitsuTBL = ws.Name
   
    For y = this_year To this_year + 1
        Sheets(Str(y)).Select
        For m = 1 To 12
            ' 翌月１日の前日を取得
            sLast = DateSerial(y, m + 1, 0)
            ' 末日の日を取得
            sLastDay = Format(sLast, "d")

            For d = 1 To sLastDay
                Set cell_date = Cells(org_c + d, org_r + (m - 1) * (num_box + 1))   ' 1日目を書くセル
                x_date = DateSerial(y, m, d)
                cell_date.Value = x_date
                cell_date.NumberFormatLocal = "d"
                
                ' 祝日テーブルを検索
                On Error Resume Next
                xlookup = ""
                xlookup = WorksheetFunction.VLookup(Format(x_date, "yyyy/m/d"), Sheets(xShukujitu).Range(ShukujitsuTBL), 2, False)
                On Error GoTo 0
                If xlookup <> "" Then
                    ' 祝日テーブルにあった！
                    cell_date.Offset(0, 1).Value = xlookup
                    cell_date.Font.Color = RGB(255, 0, 0)
                End If
                
                Select Case Weekday(x_date)
                Case 1  ' 日曜
                    Range(cell_date, cell_date.Offset(0, num_box)).Interior.Color = RGB(255, 153, 204)
                Case 7  ' 土曜
                    Range(cell_date, cell_date.Offset(0, num_box)).Interior.Color = RGB(0, 204, 255)
                End Select
            Next
            
            Set cell_month = Cells(org_c, org_r + (m - 1) * (num_box + 1))  ' 月の名前を書くセル
            cell_month.Value = m & "月"
            ' 枠線を引く
            With Range(cell_month, cell_month.Offset(sLastDay, num_box))
                .Borders.LineStyle = xlContinuous
                .BorderAround Weight:=xlThick
            End With
        Next
    Next
End Sub

' シートの存在を判定する関数
Private Function ExistsSheet(ByVal bName As String)
    Dim ws As Variant
    ExistsSheet = False
    For Each ws In Sheets
        If LCase(ws.Name) = LCase(bName) Then
            ExistsSheet = True ' 存在した
            Exit Function
        End If
    Next
End Function