ダウンロードとコピペで使えるExcelVBAのカレンダーコントロール

ダウンロードとコピペで使えるExcelVBAのカレンダーコントロール

セルをダブルクリックしたらカレンダーコントロールが開いて、日付をクリックすると最初のセルに入力される、というマクロです。難しいところはわからなくてもいいから、かんたんシンプルにサクッと使える方向性を目指しました。


関連記事

以前も似たような記事を書いたことがあるのですが、完全に「イチから自作」のコンセプトでした。まーでも、けっこうめんどくさいですよね。自分で作って勉強してみたい方はチャレンジしてみてくださいね!

なお、祝日対応の記載も一応ありますが、がんばってマクロでやるより、きぬあささんのアドインが絶対便利です! こちらもぜひどうぞ!

動画版もあります

今回の記事は動画でも解説してます。テキストよりそっちのほうが好きという方はこちらからどうぞ!

ダウンロード

こちらからzipファイルをダウンロードして、展開してください。

DLの前にお読みください

Windows10/11、Microsoft365のExcelで動作確認を行っています。ご利用の際はOfficeを最新バージョンへアップデートしてください。OSやOfficeのバージョンが古い場合、一部動作しない可能性があります。

また、コードには細心の注意を払っておりますが、無保証のコントロールとさせていただいています。いかなる理由により損害等が発生しても一切責任を負いかねますので、あらかじめご了承のうえご利用ください。

更新履歴

  • ターゲットのセルが結合セルだった場合に対応(2022/11/4)
  • ダブルクリックしたセルの近くにカレンダーが表示されるように改良(2022/11/14)
  • カレンダーの表示位置をデフォルト(画面中央)へ戻しました(2022/12/5)

※変更により、動画で映っている画面と異なる部分があります。

以下の3つのファイルが入っています。

  • F_CalenderForm.frm
  • F_CalenderForm.frx
  • M_CalendarSetting.bas

VBEのプロジェクトエクスプローラー内の「VBAProject」を右クリックして「ファイルのインポート」を選択し、「F_Calendar.frm」と「M_CalendarSetting.bas」をそれぞれ読み込みます。

プロジェクトエクスプローラーがこのようになっていれば、フォームモジュール「F_Calendar」と標準モジュール「M_CalendarSetting」が正しく読み込まれています。

シートモジュールを開く

「カレンダー」フォームを利用したいシートモジュールを選びます。ダブルクリックで開きます。

シートモジュールにコピペするコード

該当のシートモジュールに以下をコピペします。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Call setCalendarDateForCell(Target)
End Sub

これで、コードを書いたシートのいずれかのセルをダブルクリックすると「カレンダー」フォームが起動し、クリックした日付が対象セルに挿入されます。右上のスピンボタンで、左側が-1月、右側が+1月へ遷移します。

カスタマイズ

特定のセルだけ

そのままだと全セル動いてしまうので、特定のセルだけカレンダーを起動したい場合は、以下のコードに差し替えます。「”$A$1″」の部分を好きなセルに書き換えてください。「”」と「$」は必要です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Address <> "$A$1" Then Exit Sub 'A1セル以外なら終了
  Call setCalendarDateForCell(Target)
End Sub

特定セルを複数にする

カレンダーを起動したいセルを複数セルで指定したい場合は、以下のコードに差し替えます。好きなセルに書き換えてください。「”」と「$」は必要です。増やす場合は「,」で区切ります。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim ary() As Variant
  ary = Array("$A$1", "$B$2", "$C$3") 'セルを指定
  
  Dim rsl As Variant
  rsl = Filter(ary, Target.Address)
  If UBound(rsl) = -1 Then Exit Sub '指定セルが含まれていなければ終了
  
  Call setCalendarDateForCell(Target)
End Sub

特定の列だけ

特定の列だけカレンダーを起動したい場合は、以下のコードに差し替えます。A列なら1、B列なら2、という具合に数値で指定します。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column <> 4 Then Exit Sub '4列目(D列)以外なら終了
  Call setCalendarDateForCell(Target)
End Sub

特定の行だけ

特定の行だけカレンダーを起動したい場合は、以下のコードに差し替えます。数値で指定します。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Row <> 2 Then Exit Sub '2行目以外なら終了
  Call setCalendarDateForCell(Target)
End Sub

表示できる年数を変更する

カレンダー上の年数を変更したい場合は、VBEでF_Calendarを右クリックして、「コードの表示」を選択します。

「UserForm_Initialize」プロシージャの、図でハイライトしてある -3 To 3 の部分をお好きな数値に変更してください。±5年とかにしてもいいですし、前後で違う数でも大丈夫です。

For i = 0 To 5 にすると、以下のような表示になります。

以上です! 選択肢の1つとして、こんな方法もあるんだ~と思っていただけたら嬉しいです。

追記1: 祝日対応

リクエストをいただいたので作ってみました。こちらのwebAPI(国民の祝日チェック)をお借りしており、永続的ではないこと、トラブルなどに対して無保証であることをご了承ください。

こちらのカスタマイズではインターネット環境が必須です。また、祝日未実装のものに比べて、起動や月の切り替えに時間がかかります。PCスペックやネット回線速度などによって異なると思われますので、ご自身の環境にて実用に耐えうるかご判断ください。

以下、実装方法です。最新版をDLしてインポートしてからはじめてください。

フォームモジュール「F_Calendar」を右クリックして、「コードの表示」を選択し、ハイライトしてある祝日判定用のプロシージャを追加します。場所はどこでも構いませんが、迷う方は上下のプロシージャの位置を参考に挿入してください。

Private Sub setCalendar()
  '## カレンダーの作成と表示
  '略
End Sub

Private Function isHoliday(ByVal tgtDay As Date) As Boolean
  '## 祝日の判定(https://s-proj.com/utils/holiday.html)
  
  Dim httpReq As Object
  Set httpReq = CreateObject("MSXML2.ServerXMLHTTP") 'HTTPリクエスト用オブジェクト作成
  
  httpReq.Open "GET", "https://s-proj.com/utils/checkHoliday.php?kind=ph&date=" & Format(tgtDay, "yyyymmdd")
  httpReq.send '送信
  Do While httpReq.readyState < 4 '待機
    DoEvents
  Loop
  If httpReq.responseText = "holiday" Then isHoliday = True '受取&判定
   
  Set httpReq = Nothing
End Function

Private Sub spn_monthUpDown_SpinUp()
  '## スピンボタンのアップクリック時
  '略
End Sub

続いて、同じ「F_Calendar」モジュール内の「setCalendar」プロシージャへ、ハイライト部分を追加してください。

Private Sub setCalendar()
  '## カレンダーの作成と表示
  '略
    
  For i = 1 To 37 'ラベルの初期化
    With Me("lbl_day" & i)
      .Caption = "" 'キャプション
      .BorderStyle = fmBorderStyleNone '枠なし
      .BackColor = Me.BackColor 'フォームと同じ背景色へ
      Select Case i Mod 7
        Case 1
          .ForeColor = vbRed '日曜は文字色を赤
        Case 0
          .ForeColor = vbBlue '土曜は文字色を青
        Case Else
          .ForeColor = vbBlack 'その他(平日)は文字色を黒
      End Select
    End With
  Next
  
  '略
  
  Dim tgtDay As Date '日付生成用変数
  For i = 1 To endDay '1日から月末日まで
    tgtDay = yy & "/" & mm & "/" & i '該当日付生成
    With Me("lbl_day" & n + i) '該当のラベルに対して
      .Caption = i '日を入れる
      If tgtDay = Date Then '今日なら
        .BorderStyle = fmBorderStyleSingle '枠を付ける
      End If
      If tgtDay = g_cldCurrentDate Then 'TextBoxの日と同じなら
        .BackColor = RGB(200, 200, 200) '背景色を付ける
      End If
      If isHoliday(tgtDay) Then '祝日なら
        .ForeColor = vbRed '文字色を赤
      End If
    End With
  Next i
End Sub

以上で祝日が赤くなります。

公開日:2022/10/23
更新日:2022/12/05

17件のコメント

  1. 匿名 より:

    カレンダー起動時の日付を今日ではなく、excelの表の中で一番最後の日を基準にするにはどうしたら良いですか?

    • *yuko より:

      コメントありがとうございます。表を指定のセル範囲と仮定して、セル範囲内の日付で一番大きいものを起動時の初期値にする方法を考えてみました。

      インポートした標準モジュール「M_CalendarSetting」内の「setCalendarDateForCell」プロシージャへハイライト部分を追加し、8行目のセル範囲を任意のものに変更してみてください。

      Public Sub setCalendarDateForCell(ByVal tgtRange As Range)
        '## カレンダーで選択した日付をセルに入力する
      
        If IsDate(tgtRange.Cells(1, 1).Value) = False Then '日付が入ってなければ
          g_cldCurrentDate = Date '今日の日付を格納
          
          Dim maxDate As Date, rng As Range
          For Each rng In Range("A1:E5") 'セル範囲を指定する
            If IsDate(rng.Value) Then
              If maxDate = 0 Then
                maxDate = rng.Value
              Else
                If maxDate < rng.Value Then maxDate = rng.Value
              End If
            End If
          Next
          If maxDate <> 0 Then g_cldCurrentDate = maxDate
        Else
          g_cldCurrentDate = tgtRange.Cells(1, 1).Value 'セルの日付を格納
        End If
      
        F_Calendar.Show 'カレンダーを開く
      
        If g_isCldCancel = True Then Exit Sub 'キャンセル(バツボタンで閉じられた)なら終了
        tgtRange.Value = g_cldPickedDate 'クリックされた日付を上書き
      End Sub
      
  2. 匿名 より:

    失礼します。ありがたく使用させていただこうとしている者なのですが、
    結合したセルをターゲットにしたい場合はどうすればいいですか?

    • *yuko より:

      コメントありがとうございます。結合セルで試したところ、入力済みの日付を認識できない問題がありましたので、修正して更新いたしました。再度ダウンロードしてお試しください。自分では結合セルで使ったことがなかったので思わぬバグを発見させていただき、ありがとうございました。

  3. 匿名 より:

    調べて調べて調べまくってこちらに辿り着くことができました。

    とても素晴らしいものを与えてくださりありがとうございます。

    以下対応方法などお分かりでしたら教えてもらうことはできますか?
    ・祝日の反映は可能なのか。
    ・テーブル機能に使おうとしていて、最初のセルには反映できるのですが、追加行のセルへの対応がわかりません。

    • *yuko より:

      コメント&暖かいお言葉を、ありがとうございます。

      祝日対応ですが、外部APIを利用すれば不可能ではなさそうです。私も興味があるので作ってみようかと思いますので、少々お時間をください。ただ、外部サービスを利用するので永続的ではないこと、動作が遅くなること、トラブルなどに対して無保証であることをご了承ください。

      > テーブル機能に使おうとしていて、最初のセルには反映できるのですが、追加行のセルへの対応がわかりません

      こちらの件は、テーブルに対して行列の挿入を行って試してみたのですが、現象の再現ができませんでした。再現できないことには対処ができず、申し訳ありません。

  4. 匿名 より:

    お返事ありがとうございます。
    需要がありそうな際のご対応で大丈夫ですので、何卒ご無理なさらずにお願い致します。

    最後に一つ、紹介されている列指定について複数の列はどのように指定したらいいのでしょうか?
    例えば、A列、C列、E列に指定したいなどの時です。もしくはA列~C列に指定などの時です。

    お忙しいところ恐縮ですが是非ご回答頂ければ幸いです。

    • *yuko より:

      祝日対応、本文に追記しましたので見てみてくださいね。

      列指定は、例では1つの条件を扱ったので、「If Target.Column <> ○ Then Exit Sub(○以外なら終了)」という書き方をしていますが、複数条件だと以下のような書き方のほうがわかりやすいかと思います。

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If 1 <= Target.Column And Target.Column <= 3 Then 'A~C列のとき
          Call setCalendarDateForCell(Target)
        End If
      End Sub
      
      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Target.Column = 1 Or Target.Column = 3 Or Target.Column = 5 Then 'AまたはCまたはE列のとき
          Call setCalendarDateForCell(Target)
        End If
      End Sub
      
  5. 匿名 より:

    お返事が遅くなってしまってすみません。
    2点とも対応してくださりありがとうございます。
    とても参考になり、助かります!

  6. 匿名 より:

    ターゲットのセルが結合セルだった場合に対応(2022/11/4)となっておりますが、結合セルで反応しません。
    対処方法を教えてください。

    • *yuko より:

      コメントありがとうございます。Windows10/11、Microsoft365のExcelで動作することを確認しております。OSやOfficeのバージョンが古い場合、一部動作しない可能性があります。Microsoft365をお使いの場合、Officeを最新バージョンへアップデートしてください。また、新規ブック状態から試して、拡張子は.xlsではなく.xlsmで動くかどうかお試しください。(既存ブックだと先に組み込まれている環境が動作に影響する場合があります。)

  7. 匿名 より:

    ダブルクリックした際のコントロールの表示位置が、だんだん下がってしまい30行以降になるとフレームアウトしてしまします。

    コントロール表示がフレームアウトすると、EXCELがフリーズしてしまいます。
    コントロール表示位置の調整は可能でしょうか??

    • *yuko より:

      コメントありがとうございます。2022/11/14の更新でダブルクリックしたセルの近くに表示されるようにしたのですが、画面やウィンドウの大きさによって動作が不安定であることがわかりました。デフォルト位置(画面中央表示)へ戻しましたので、お手数ですが最新版をDLし直してお試しください。

  8. 匿名 より:

    当方トリプルモニターで作業しているのですが、複数のセルに指定していまして、ダブルクリックした時にカレンダーの表示がすごい離れたところに表示されてしまいます。入力セルが横にずれればずれる程、隣の画面にカレンダーが現れ、更に隣の画面へと遠くなっていき、隠れてしまったら消すこともできずに強制終了するしかできませんでした。

    何か表示を指定のセルに近くする対処法はありますか?

  9. 匿名 より:

    先程質問したものです。
    もう一度こちらの操作方法の通常通りでやってみたらちゃんとできていました。

    何かそのファイルの中で他の改修をした際におかしくなってしまったようです。
    差し支えなければ、セルの近くに置く場合はどこをいじるのか教えて頂きますとこちらでやってみようかと思います。

    • *yuko より:

      まとめてのお返事で失礼いたします。上の方の回答と同じく、以前の更新でセルの近くを判定するコードを入れたものが、画面やウィンドウの大きさによって動作が安定しなかったのが原因のようです。デフォルト位置(画面中央表示)へ戻しましたので、お手数ですが最新版をDLし直してお試しください。


コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください

コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)