【Excel】日付をカレンダーで選択させる(デートピッカー)

Webアプリではカレンダーを使用して日付を入力させるものが増えてきています。

カレンダーで日付を入力させるメリットとして…

  • 日付以外の値が入力されにくくなる
  • キーボード入力が不要でマウスだけで完結できる
  • 曜日などを確認しながら入力できる

などがあり、システム側にもユーザ側にも恩恵があります。

そこで、Excelでもセルに日付を入力する際にデートピッカーを使用したほうが便利ではないかと思いました。

色々と調べましたが、標準の日付コントロールなどはACCESSがないと使用できないようなのでユーザーフォームを使用して自作してみることにしました。

ユーザーフォームでデートピッカーを作成

フォームの作成とプロパティ設定

VBEを開いて、「右クリック – 挿入 – ユーザーフォーム」と操作します。

するとユーザーフォームの編集画面になります。

ここから自由に画面レイアウトを作成することができるので、カレンダーを作ってみたいと思います。

まずは、作成したユーザーフォームのプロパティを以下のように設定いたしました。

※プロパティウィンドウが表示されていない場合は、「表示 – プロパティウィンドウ」から表示させることができます。

  • オブジェクト名 : frmDatePicker
  • Caption :日付選択

オブジェクト名は、このフォームを呼び出す際に使用する名前で、Captionはウィンドウタイトルになります。

ラベルとコンボボックスを使用してカレンダーを作成する

次にラベルとコンボボックスを使用して、下記のようなフォームを作成します。年と月の部分がコンボボックスになっていて、他がすべてラベルになっています。

ボタンになる部分には、プロパティからオブジェクト名を付けます。プログラムソースから呼び出しがあるためです。

  • ←:lblPrev
  • →:lblNext
  • 年コンボボックス:cmbYear
  • 月コンボボックス:cmbMonth
  • 日付のラベル:lblDate1 ~ lblDate42

VB6とかであれば、同じ名前にしてコントロール配列にするのですが、VBAはコントロールの配列がないようなので非常に面倒くさいです…。

初期処理を作成する

カレンダー用のフォーム準備ができたので、次にVBAでコードを記載していきます。(フォームを右クリックしてコードを表示)

まずこのフォームが起動されたときの初期処理として、以下を実装します。

  • 年と月のコンボボックスの選択肢を作成
  • 現在月のカレンダーを表示する

実際に作成したコードが以下になります。

引数を渡したかったので、標準のUserForm_Initializeではなく独自の関数名で作成しています。

※直接showされるとバグるので、極力UserForm_Initializeを使用したほうがいいのですが、引数がないとどちらにしても使えないので今回はOKにしました。

Public Sub init(rngTarget_ As Range)
    
    '日付のラベルを配列化する
    Set lblDate(1) = Me.lblDate1
    Set lblDate(2) = Me.lblDate2
    Set lblDate(3) = Me.lblDate3
    Set lblDate(4) = Me.lblDate4
    Set lblDate(5) = Me.lblDate5
    Set lblDate(6) = Me.lblDate6
    Set lblDate(7) = Me.lblDate7
    Set lblDate(8) = Me.lblDate8
    Set lblDate(9) = Me.lblDate9
    Set lblDate(10) = Me.lblDate10
    Set lblDate(11) = Me.lblDate11
    Set lblDate(12) = Me.lblDate12
    Set lblDate(13) = Me.lblDate13
    Set lblDate(14) = Me.lblDate14
    Set lblDate(15) = Me.lblDate15
    Set lblDate(16) = Me.lblDate16
    Set lblDate(17) = Me.lblDate17
    Set lblDate(18) = Me.lblDate18
    Set lblDate(19) = Me.lblDate19
    Set lblDate(20) = Me.lblDate20
    Set lblDate(21) = Me.lblDate21
    Set lblDate(22) = Me.lblDate22
    Set lblDate(23) = Me.lblDate23
    Set lblDate(24) = Me.lblDate24
    Set lblDate(25) = Me.lblDate25
    Set lblDate(26) = Me.lblDate26
    Set lblDate(27) = Me.lblDate27
    Set lblDate(28) = Me.lblDate28
    Set lblDate(29) = Me.lblDate29
    Set lblDate(30) = Me.lblDate30
    Set lblDate(31) = Me.lblDate31
    Set lblDate(32) = Me.lblDate32
    Set lblDate(33) = Me.lblDate33
    Set lblDate(34) = Me.lblDate34
    Set lblDate(35) = Me.lblDate35
    Set lblDate(36) = Me.lblDate36
    Set lblDate(37) = Me.lblDate37
    Set lblDate(38) = Me.lblDate38
    Set lblDate(39) = Me.lblDate39
    Set lblDate(40) = Me.lblDate40
    Set lblDate(41) = Me.lblDate41
    Set lblDate(42) = Me.lblDate42
    
    Dim dtToday As Date
    dtToday = Date
    
    '既に値が登録済みの場合は、その値を初期値とする
    If rngTarget_.Value <> "" And IsDate(rngTarget_.Value) Then
        intSelectedMonth = month(rngTarget_)
        intSelectedYear = year(rngTarget_)
    Else
        '新規入力の場合は、現在年月を初期値とする
        intSelectedMonth = month(dtToday)
        intSelectedYear = year(dtToday)
    End If
    
    Set rngTarget = rngTarget_
    Dim i As Integer
    
    '年のコンボボックスを作成(現在年から10年以内を設定)
    Const YEAR_RANGE = 10
    For i = -YEAR_RANGE To YEAR_RANGE
        cmbYear.AddItem intSelectedYear + i
    Next
    '現在年をコンボボックスに設定する
    cmbYear.ListIndex = YEAR_RANGE
    
    '月のコンボボックスを作成
    For i = 1 To 12
        cmbMonth.AddItem i
    Next
    '現在月をコンボボックスに設定する
    cmbMonth.ListIndex = intSelectedMonth - 1
    
    '日付を設定する
    Call SetDate
    
    'フォームを表示する
    Me.Show vbModal
End Sub

日付を設定したいセルを引数で渡す形にしました。すでにセルに値が入力されていた場合は、その値の年月を初期表示します。

前述の通りコントロールを配列として使えないので、無理やり配列にして使いやすいようにしています。

年のコンボボックスは設定値をどうするか迷ったのですが、現在年から10年以内を設定することにしました。10年以上前の日付や10年後の日付を設定することはほぼないと思ったためです。

前月、次月ボタンを実装する

次に矢印(前月、次月)ボタンの実装をします。

「コントロール名+_Click」という命名で関数を作成すると、そのコントロールが実行されたときに呼ばれるようになります。

Private Sub lblPrev_Click()
    '月を-1する
    intSelectedMonth = intSelectedMonth - 1
    
    If intSelectedMonth = 0 Then
        '1月の場合の処理
        cmbYear.ListIndex = cmbYear.ListIndex - 1
        intSelectedMonth = 12
    End If
    cmbMonth.ListIndex = intSelectedMonth - 1
    
    '日付を設定する
    Call SetDate
    
End Sub

Private Sub lblNext_Click()
    '月を+1する
    intSelectedMonth = intSelectedMonth + 1
    
    If intSelectedMonth = 13 Then
        '12月の場合の処理
        cmbYear.ListIndex = cmbYear.ListIndex + 1
        intSelectedMonth = 1
    End If
    cmbMonth.ListIndex = intSelectedMonth - 1
    
    '日付を設定する
    Call SetDate
End Sub

コンボボックス変更時のイベントを作成する

前月、次月ボタンと同様に、年と月のコンボボックスが変更されたときの処理を作成します。

「コントロール名+_Change」という命名で関数を作成すると、コンボボックスが変更されたときに呼ばれる関数が作成できます。

Private Sub cmbMonth_Change()
    intSelectedMonth = cmbMonth.Value
    '日付を設定する
    Call SetDate
End Sub

Private Sub cmbYear_Change()
    intSelectedYear = cmbYear.Value
    '日付を設定する
    Call SetDate
End Sub

日付選択時の動作を実装する

次にカレンダー上の日付を選択したときに、カレンダーを読んだセルに値を入れる関数を作成します。

Private Sub setDateToCell(ByVal day As String)
    If day = "" Then
        Exit Sub
    End If
    
    '呼び元のセルに選択した日付を設定する
    rngTarget.Value = DateSerial(intSelectedYear, intSelectedMonth, day)
    
    'カレンダーを消す
    Unload Me
End Sub

Private Sub lblDate1_Click()
    Call setDateToCell(lblDate1.Caption)
End Sub
Private Sub lblDate2_Click()
    Call setDateToCell(lblDate2.Caption)
End Sub
Private Sub lblDate3_Click()
    Call setDateToCell(lblDate3.Caption)
End Sub
Private Sub lblDate4_Click()
    Call setDateToCell(lblDate4.Caption)
End Sub
Private Sub lblDate5_Click()
    Call setDateToCell(lblDate5.Caption)
End Sub
Private Sub lblDate6_Click()
    Call setDateToCell(lblDate6.Caption)
End Sub
Private Sub lblDate7_Click()
    Call setDateToCell(lblDate7.Caption)
End Sub
Private Sub lblDate8_Click()
    Call setDateToCell(lblDate8.Caption)
End Sub
Private Sub lblDate9_Click()
    Call setDateToCell(lblDate9.Caption)
End Sub
Private Sub lblDate10_Click()
    Call setDateToCell(lblDate10.Caption)
End Sub
Private Sub lblDate11_Click()
    Call setDateToCell(lblDate11.Caption)
End Sub
Private Sub lblDate12_Click()
    Call setDateToCell(lblDate12.Caption)
End Sub
Private Sub lblDate13_Click()
    Call setDateToCell(lblDate13.Caption)
End Sub
Private Sub lblDate14_Click()
    Call setDateToCell(lblDate14.Caption)
End Sub
Private Sub lblDate15_Click()
    Call setDateToCell(lblDate15.Caption)
End Sub
Private Sub lblDate16_Click()
    Call setDateToCell(lblDate16.Caption)
End Sub
Private Sub lblDate17_Click()
    Call setDateToCell(lblDate17.Caption)
End Sub
Private Sub lblDate18_Click()
    Call setDateToCell(lblDate18.Caption)
End Sub
Private Sub lblDate19_Click()
    Call setDateToCell(lblDate19.Caption)
End Sub
Private Sub lblDate20_Click()
    Call setDateToCell(lblDate20.Caption)
End Sub
Private Sub lblDate21_Click()
    Call setDateToCell(lblDate21.Caption)
End Sub
Private Sub lblDate22_Click()
    Call setDateToCell(lblDate22.Caption)
End Sub
Private Sub lblDate23_Click()
    Call setDateToCell(lblDate23.Caption)
End Sub
Private Sub lblDate24_Click()
    Call setDateToCell(lblDate24.Caption)
End Sub
Private Sub lblDate25_Click()
    Call setDateToCell(lblDate25.Caption)
End Sub
Private Sub lblDate26_Click()
    Call setDateToCell(lblDate26.Caption)
End Sub
Private Sub lblDate27_Click()
    Call setDateToCell(lblDate27.Caption)
End Sub
Private Sub lblDate28_Click()
    Call setDateToCell(lblDate28.Caption)
End Sub
Private Sub lblDate29_Click()
    Call setDateToCell(lblDate29.Caption)
End Sub
Private Sub lblDate30_Click()
    Call setDateToCell(lblDate30.Caption)
End Sub
Private Sub lblDate31_Click()
    Call setDateToCell(lblDate31.Caption)
End Sub
Private Sub lblDate32_Click()
    Call setDateToCell(lblDate32.Caption)
End Sub
Private Sub lblDate33_Click()
    Call setDateToCell(lblDate33.Caption)
End Sub
Private Sub lblDate34_Click()
    Call setDateToCell(lblDate34.Caption)
End Sub
Private Sub lblDate35_Click()
    Call setDateToCell(lblDate35.Caption)
End Sub
Private Sub lblDate36_Click()
    Call setDateToCell(lblDate36.Caption)
End Sub
Private Sub lblDate37_Click()
    Call setDateToCell(lblDate37.Caption)
End Sub
Private Sub lblDate38_Click()
    Call setDateToCell(lblDate38.Caption)
End Sub
Private Sub lblDate39_Click()
    Call setDateToCell(lblDate39.Caption)
End Sub
Private Sub lblDate40_Click()
    Call setDateToCell(lblDate40.Caption)
End Sub
Private Sub lblDate41_Click()
    Call setDateToCell(lblDate41.Caption)
End Sub
Private Sub lblDate42_Click()
    Call setDateToCell(lblDate42.Caption)
End Sub

ラベルを配列化していたのですが、クリック時のイベントは個別に実装するしか思いつかなかったので、ラベルの数だけ関数を作ることになってしまいました。

JavaScriptみたいに動的にイベントをコントロールに割り当てることができればよいのですが簡単にはできない…。

…と思っていたのですが、調べると共通ラベルクラスみたいなものを使用すれば、動的にイベントを割り当てているのと同じ動作になるっぽいですね。

https://excel-ubara.com/excelvba3/EXCELFORM023.html

クラスにオブジェクトを渡してしまって、クラス側で処理を書くって感じですね。これはトリッキーですが、知っておくと使える場面が多そうです。

暇があったら自分もチャレンジしてみたいと思います。

デートピッカーを呼び出す

ここまでで、デートピッカーの作成は完了しているので、後は呼び出すだけになります。

今回は、「特定のワークシート上の2列目のセルをクリックしたら、カレンダーピックから選択させる」という仕様にしたいと思います。

作成したシートとコードは以下のとおりです。

シート

コード

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const ROW_START = 2
    Const COL_DATE = 2
    
    'コピペ中は邪魔になるので呼び出さない
    If Application.CutCopyMode Then
        Exit Sub
    End If
    
    If Target.Column = COL_DATE And Target.Row >= ROW_START And Target.Cells.Count = 1 Then
        'デートピックを呼び出す
        Call frmDatePicker.init(Target)
    End If
End Sub

Worksheet_SelectionChangeはセルが選択されたときに発火するイベントです。

選択されたセルの列が2列目で、更にヘッダー行以外(2行目以降)であればカレンダーを呼び出すようにしています。

範囲選択時にはカレンダーを使用したくないので、Target.Cells.Count = 1という条件も入れています。これでオートフィルは普通に使えるようになります。

また、カレンダーから選択ではなくコピペで入力したいときもあると思うので、コピーしているときは、カレンダーを呼び出さないようにしています。


サンプル

ここまでの作業で作成したプログラムが以下になります。

https://vbaexcel.slavesystems.com/product/%E3%82%AB%E3%83%AC%E3%83%B3%E3%83%80%E3%83%BC%E3%82%B5%E3%83%B3%E3%83%97%E3%83%AB.zip

動作は以下の画像のような形になります。

日曜日とかを選択したくないときは、やはり曜日が見えるのは便利だと思います。

祝日とかも表せるようにできると更に良くなる気がします。


2 件のコメント

  • 初めまして、こんにちは。
    VBA初心者の女性です。

    出来うる限り最低限の入力とマウスのみで上司が使用できる
    一覧表を作成して欲しいという上司の希望のもと
    トラベルWebサイトの様にカレンダーで日付を入力しようと思いつき
    探していたところこちらに辿り着き、参考にさせて頂き大変助かりました。
    ありがとうございます。

    ところでその上司がカレンダーからカレンダーをEscキーで閉じる様に
    出来ると更に助かるとの追加注文が入りました。

    Unload Meを使いプロパティ画面で Cancel を True に指定するというのは
    理解したのですが一年前から業務と同時進行で勉強を始めたばかりであれこれ
    試行錯誤しましたがうまくいきません。

    自身の勉強不足を承知で大変恐縮ですがお手すきの時でもこちらの
    プログラムに追加の形で教えて頂けると大変嬉しく思います。
    お忙しいなか申し訳ありませんが、どうぞよろしくお願いいたします。

  • 再びすみません、上記の者です。
    あれから書籍で調べたりサイトを検索して
    書き直したらEscで閉じる仕様に出来ました。

    こちらのカレンダー、大変勉強になりました。
    本当にありがとうございます。

  • コメントを残す

    メールアドレスが公開されることはありません。

    日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)