月曜日, 8月 11, 2025

Excel VBA 50 
Exccelで指定月のカレンダーを作成

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を利用してカレンダーを表示します。