vba 横長カレンダー作成

VBA
Option Explicit

Private Sub test()
    
    Dim ws As Worksheet
    
    Dim StartDate As Date
    Dim EndDate As Date
    
    StartDate = "2025/1/1"
    EndDate = "2025/12/31"

    Call CreateCalendar(StartDate, EndDate, WsTask)
    

End Sub

Function WsTask() As Worksheet
    Set WsTask = ThisWorkbook.Sheets("Sheet1") ' シート1を指定
End Function


Function CreateCalendar(StartDate As Date, EndDate As Date, ws As Worksheet)

    
    Dim currentDate As Date
    Dim col As Integer
    Dim StartRow As Integer
    
    Dim EndCol As Long
    
    StartRow = 2
    col = 18 ' 12列から開始
    
    '日付範囲をクリア
    EndCol = Cells(StartRow, Columns.Count).End(xlToLeft).Column
    ws.Range(ws.Cells(StartRow, col), ws.Cells(StartRow + 3, EndCol)).ClearContents
    
    ' ループでカレンダーを作成
    For currentDate = StartDate To EndDate
        ws.Cells(StartRow, col).Value = Year(currentDate)  ' 年
        ws.Cells(StartRow + 1, col).Value = Month(currentDate) ' 月
        ws.Cells(StartRow + 2, col).Value = Day(currentDate) ' 日
        ws.Cells(StartRow + 3, col).Value = Format(currentDate, "aaa") ' 曜日(日本語)
        
        col = col + 1 ' 次の列へ
    Next currentDate
    
    ' 列の自動調整
    ws.Range(ws.Cells(StartRow, col), ws.Cells(StartRow + 3, EndCol)).EntireColumn.AutoFit
End Function

Sub CalendarColor()

    With WsTask
        For currentDate = StartDate To EndDate
            If Format(currentDate, "aaa") = "土" Or Format(currentDate, "aaa") = "日" Then
                ws.Columns(col).Interior.Color = 灰色
            End If
        Next
    End With

End Sub

コメント

タイトルとURLをコピーしました