【マクロ】フォームからシンプルなカレンダーを作成する【ダウンロード可】

Private Sub UserForm_Initialize() '各コントロールのプロパティ設定
    
    '年（テキストボックス）のプロパティ
    テキストボックス年.Value = Year(Date) '初期値を現在の西暦に
    スピンボタン年.TabStop = False 'Tabキーによるフォーカスを禁止
    
    '月（コンボボックス）のプロパティ
    With コンボボックス月
        For i = 1 To 12 '1から12を追加
            .AddItem i
        Next
        .ListIndex = Month(Date) - 1 '初期選択を現在の月に
        .Style = fmStyleDropDownList 'リスト（1～12）以外の入力を禁止
    End With

    '週の始まりの曜日（コンボボックス）のプロパティ
    With コンボボックス週の始まり
        .AddItem "日" '日を追加
        .AddItem "月" '月を追加
        .ListIndex = 0 '初期選択を日にする
        .Style = fmStyleDropDownList 'リスト（日、月）以外の入力を禁止
    End With
End Sub
Private Sub テキストボックス年_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) '年（テキストボックス）に数字しか入力できないようにする
    If Not Chr(KeyAscii) Like "[0-9]" Then
        KeyAscii = 0
    End If
End Sub
Private Sub スピンボタン年_SpinUp() 'スピンボタンで年（テキストボックス）の値を増減させる
    If Not IsNumeric(テキストボックス年) Then Exit Sub
    テキストボックス年 = テキストボックス年 + 1
End Sub
Private Sub スピンボタン年_SpinDown() 'スピンボタンで年（テキストボックス）の値を増減させる
    If Not IsNumeric(テキストボックス年) Then Exit Sub
    テキストボックス年 = テキストボックス年 - 1
End Sub
Private Sub コマンドボタン決定_Click() '決定ボタンで実行

    If IsNumeric(テキストボックス年) Then '年（テキストボックス）が数字の場合
        Call 作成モジュール.カレンダーの作成(Val(テキストボックス年), Val(コンボボックス月))
        Call 作成モジュール.月曜スタートに変更(コンボボックス週の始まり)
        Call 作成モジュール.書式変更
        Unload Me
    Else '年（テキストボックス）が数字じゃない場合
        MsgBox "数値を入力してください"
        テキストボックス年.SetFocus
    End If
End Sub

Sub フォームを開く()
    入力フォーム.Show
End Sub
Sub カレンダーの作成(年, 月)
    Sheets.Add(After:=ActiveSheet).Select 'シートを追加
    
    '年月の入力
    Range("A1").Value = 年 & "年"
    Range("D1").Value = 月 & "月"
    
    '曜日の入力
    For i = 1 To 7
        Cells(2, i) = WeekdayName(i, True)
    Next

    '日付の入力
    For i = 1 To Day(DateSerial(年, 月 + 1, 0)) '1日から月末まで繰り返し処理
        Range("A3:G8").Cells(Weekday(DateSerial(年, 月, 1)) + i - 1) = i
    Next
End Sub
Sub 月曜スタートに変更(曜日の始まり) 'カットアンドペーストで表を変更
    If 曜日の始まり = "月" Then
        Range("A2:A9").Cut
        Range("H2:H9").Insert
        Range("G3").Cut
        Cells(Range("A1").CurrentRegion.Rows.Count + 1, Range("A1").CurrentRegion.Columns.Count).Insert
    End If
End Sub
Sub 書式変更()
    Range("A1:G1").BorderAround LineStyle:=xlContinuous '表題を罫線で囲む

    '月部分
    With Range("D1")
        .Font.Size = 28 'フォントサイズ
        .Font.Bold = True '太字
    End With
    
    '曜日部分
    For Each i In Range("A2:G2")
        Select Case i '背景色の変更
            Case "日"
                i.Interior.ColorIndex = 22 '日曜は赤
            Case "土"
                i.Interior.ColorIndex = 37 '土曜は青
            Case Else
                i.Interior.ColorIndex = 15 'それ以外は灰色
        End Select
        
        i.Font.ColorIndex = 2 '文字色
        i.Font.Bold = True '太字
    Next
    
    '日付部分
    With Range("A2", Cells(Range("A1").CurrentRegion.Rows.Count, 7))
        .Borders.LineStyle = xlContinuous '罫線を引く
        .VerticalAlignment = xlTop '文字の縦位置を上詰めに
    End With
    
    '高さの調整
    Range("1:1,3:" & Range("A1").CurrentRegion.Rows.Count).RowHeight = 54 '曜日以外の高さ調整
    Range("A1:G8").HorizontalAlignment = xlCenter '文字の横位置を水平揃えに
End Sub