カレンダーフォームの作成

エクセルのユーザーフォームを使ったカレンダーの作成手順を紹介します。
caln010000.gif


＜作成手順＞
●「Visual Basic Editor」を起動します。
Excel2003･･･メニューバー「ツール→マクロ→Visual Basic Editor」
Excel2007以降･･･リボン「開発→Visual Basic Editor」(開発タブが表示されていない場合は「ファイル→オプション→リボンのユーザー設定→メインタブ→[開発]をチェックONする」)

●ツールバー「挿入→ユーザーフォーム」で新規フォームを作成して、
フォームのオブジェクト名「カレンダフォーム」、Captionプロパティ「カレンダ」とし、
フォーム上に「年」「月」用のテキストボックス(オブジェクト名「txt年」と「txt月」)を配置し、
ラベル(Captionプロパティ「年」と「月」)を配置します。
caln010010.gif

コマンドボタン(オブジェクト名「前月ボタン」、Captionプロパティ「<」と
オブジェクト名「次月ボタン」、Captionプロパティ「>」)を配置します。
caln010020.gif

曜日のラベル7個(Captionプロパティ「日」「月」「火」「水」「木」「金」「土」)と
「日」用のボタン42個(オブジェクト名「日ボタン01」～「日ボタン42」)を配置します。
caln010030.gif

●各処理のVBAコードを記述します。
caln010040.gif
Option Explicit
Dim wArrayDay(42) As Integer     'カレンダの「日」用の配列

Private Sub UserForm_Initialize()     'フォームを表示した時の処理
    rtnDate = Null     '日付受渡し用変数を初期化
    Me.txt年 = Year(Date)     '「年」へ今年をセット
    Me.txt月 = Month(Date)     '「月」へ今月をセット
    Call SetCalender     'カレンダ セット処理(下部へ記述)
End Sub

Private Sub 前月ボタン_Click()     '前月[<]ボタン押下時の処理
    Dim wDate As Date
    wDate = DateAdd("m", -1, DateSerial(Me.txt年, Me.txt月, 1))     '前月の1日を算出
    Me.txt年 = Year(wDate)     '「年」へ前月の年をセット
    Me.txt月 = Month(wDate)     '「月」へ前月をセット
    Call SetCalender     'カレンダ セット処理(下部へ記述)
End Sub

Private Sub 次月ボタン_Click()     '次月[>]ボタン押下時の処理
    Dim wDate As Date
    wDate = DateAdd("m", 1, DateSerial(Me.txt年, Me.txt月, 1))     '翌月の1日を算出
    Me.txt年 = Year(wDate)     '「年」へ翌月の年をセット
    Me.txt月 = Month(wDate)     '「月」へ翌月をセット
    Call SetCalender     'カレンダ セット処理(下部へ記述)
End Sub

Private Sub txt年_AfterUpdate()     '「年」入力時の処理
    Call SetCalender     'カレンダ セット処理(下部へ記述)
End Sub

Private Sub txt月_AfterUpdate()     '「月」入力時の処理
    Call SetCalender     'カレンダ セット処理(下部へ記述)
End Sub

Private Sub 日ボタン01_Click()     '1番目の日ボタン クリック時の処理
    Call ClickDate(1)     'カレンダの日ボタン選択時の処理(下部へ記述)
End Sub

Private Sub 日ボタン02_Click()
    Call ClickDate(2)
End Sub

※中略 「日ボタン03」～「日ボタン41」

Private Sub 日ボタン42_Click()
    Call ClickDate(42)
End Sub

Private Sub SetCalender()     'カレンダ セット処理
    Dim wDate As Date
    Dim wTopNo As Integer
    Dim wLastDay As Integer
    Dim wIdx1 As Integer
    Dim wDay As Integer

    If IsNumeric(Me.txt年) = False Then
        Me.txt年 = Year(Date)     '「年」に数値が入力されていない場合は今年をセット
    End If
    If Me.txt月 < 1 Or Me.txt月 > 12 Then
        Me.txt月 = Month(Date)     '「月」に1～12が入力されていない場合は今月をセット
    End If

    For wIdx1 = 1 To 42
        wArrayDay(wIdx1) = 0     '「日」用の配列を初期化
    Next

    wDate = DateSerial(Me.txt年, Me.txt月, 1)     '「年」「月」の月初日の日付を算出
    wLastDay = Day(DateAdd("d", -1, DateAdd("m", 1, wDate)))     '月末の日を算出
    wTopNo = Format(wDate, "w")     '月初日の曜日を先頭番号として算出
    wIdx1 = wTopNo
    wDay = 1
    For wDay = 1 To wLastDay
        wArrayDay(wIdx1) = wDay     '月初日から月末日までを「日」用の配列にセット
        wIdx1 = wIdx1 + 1
    Next

    '「日」用の配列に従って「日」ボタンに日を表示
    For wIdx1 = 1 To 42
        If wArrayDay(wIdx1) <> 0 Then
            Me("日ボタン" & Format(wIdx1, "00")).Caption = Format(wArrayDay(wIdx1), "#")
            Me("日ボタン" & Format(wIdx1, "00")).Enabled = True
        Else
            Me("日ボタン" & Format(wIdx1, "00")).Caption = ""
            Me("日ボタン" & Format(wIdx1, "00")).Enabled = False
        End If
    Next

    'カレンダに今月が表示されている場合は今日の日のボタンにフォーカスをセット
    If Year(Date) = Val(Me.txt年) And Month(Date) = Val(Me.txt月) Then
        Me("日ボタン" & Format(wTopNo - 1 + Day(Date), "00")).SetFocus
    Else
        Me("日ボタン" & Format(wTopNo, "00")).SetFocus
    End If
End Sub

Private Sub ClickDate(prmClnNo)    'カレンダの日ボタン選択時の処理
    'クリックされた日ボタンの日付を算出して日付受渡し用変数へセット
    rtnDate = DateSerial(Me.txt年, Me.txt月, wArrayDay(prmClnNo))
    Unload Me     'カレンダフォームを閉じる
End Sub


●標準モジュールへカレンダフォームで選択した日付の受渡し用の変数を宣言します。
caln010050.gif
Option Explicit
Public rtnDate As Variant     'カレンダフォームで選択した日付の受渡し用


●カレンダフォームの呼び出し
caln010005.gif

caln010060.gif
Option Explicit
Private Sub カレンダボタン_Click()
    カレンダフォーム.Show vbModal     'カレンダフォームの呼び出し
    Range("B2") = rtnDate     'カレンダフォームから受け渡された日付をB2セルへセット
End Sub


＜完成＞
caln010000.gif