Exccelで指定した年月のカレンダーを作成します。
Sub CreateCalendarFromUserInput()
Dim ws As Worksheet
Dim yearInput As Integer, monthInput As Integer
Dim startDate As Date, endDate As Date
Dim row As Integer, col As Integer, dayCounter As Integer
' シートを取得(カレンダーシートを作成・クリア)
Set ws = ThisWorkbook.Sheets("Sheet1")
' 必要に応じてシート名を変更
ws.Cells.Clear ' 既存のカレンダーをクリア
' ユーザーに年と月を入力してもらう
yearInput = InputBox("西暦を入力してください(例:2025)", _
"年の入力")
If yearInput < 1900 Or yearInput > 2100 Then
MsgBox "有効な年(1900?2100)を入力してください。", _
vbExclamation
Exit Sub
End If
monthInput = InputBox("月を入力してください(1?12)", _
"月の入力")
If monthInput < 1 Or monthInput > 12 Then
MsgBox "有効な月(1?12)を入力してください。", _
vbExclamation
Exit Sub
End If
' 開始日と終了日を設定
startDate = DateSerial(yearInput, monthInput, 1)
endDate = DateSerial(yearInput, monthInput + 1, 0)
' ヘッダーにタイトル
ws.Cells(1, 1).Value = yearInput & "年 " & monthInput & "月"
ws.Cells(1, 1).Font.Size = 14
ws.Cells(1, 1).Font.Bold = True
ws.Range("A1:G1").Merge
ws.Cells(1, 1).HorizontalAlignment = xlCenter
' 曜日ヘッダー
Dim daysOfWeek As Variant
daysOfWeek = Array("日", "月", "火", "水", "木", "金", "土")
' 曜日を2行目に設定
For col = 0 To 6
ws.Cells(2, col + 1).Value = daysOfWeek(col)
ws.Cells(2, col + 1).Font.Bold = True
ws.Cells(2, col + 1).HorizontalAlignment = xlCenter
ws.Cells(2, col + 1).Interior.Color = RGB(200, 200, 250)
' ヘッダーの背景色
Next col
' 日付を埋める
row = 3
col = weekDay(startDate, vbSunday) - 1
' 週の最初の曜日(0:日曜, 6:土曜)
For dayCounter = 1 To Day(endDate)
ws.Cells(row, col + 1).Value = dayCounter
ws.Cells(row, col + 1).HorizontalAlignment = xlCenter
col = col + 1
If col > 6 Then
col = 0
row = row + 1
End If
Next dayCounter
' セルのサイズ調整
ws.Cells.EntireColumn.AutoFit
ws.Range("A2:G2").Interior.Color = RGB(200, 200, 250)
' ヘッダー色
ws.Range("A3:G" & row).Borders.LineStyle = xlContinuous
' 罫線
MsgBox "カレンダーが作成されました!", vbInformation
End Sub
実行したら年月を入力すれば・・・
A2〜G8を利用してカレンダーを表示します。