ダウンロードとコピペで使える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
結合セルは以下の形で書きます。「”$A$1:$B$2″」部分はすべて大文字・半角英数字です。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1:$B$2" Then Exit Sub 'A1:B2の結合セル以外なら終了 Call setCalendarDateForCell(Target) End Sub
（2023/7/15追記）コメント欄で教えていただきました！ 結合セルで上のコードでうまくいかない場合、こちらでも試してみてください。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub 'A1:B2の結合セル以外なら終了
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") 'セルを指定
If Not hasTarget(ary, Target.Address) Then Exit Sub '指定セルが存在しなければ終了
Call setCalendarDateForCell(Target)
End Sub
Private Function hasTarget(ByVal ary As Variant, ByVal tgt As String) '存在チェック
Dim tmp As Variant
For Each tmp In ary
If tmp = tgt Then
hasTarget = True
Exit Function
End If
Next
End Function
以下のように単一セルと結合セルを混ぜてもOKです。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ary() As Variant
ary = Array("$A$1", "$B$2:$C$3", "$D$4") 'セルを指定
If Not hasTarget(ary, Target.Address) Then Exit Sub '指定セルが存在しなければ終了
Call setCalendarDateForCell(Target)
End Sub
Private Function hasTarget(ByVal ary As Variant, ByVal tgt As String) '存在チェック
Dim tmp As Variant
For Each tmp In ary
If tmp = tgt Then
hasTarget = True
Exit Function
End If
Next
End Function
特定の列/行だけ
特定の列だけカレンダーを起動したい場合は、以下のコードに差し替えます。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
A～C列のとき、のように書く場合は以下です。行にする場合はTarget.ColumnをTarget.Rowに変更してください。
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
AまたはCまたはE列のとき、のように書く場合は以下です。行にする場合はTarget.ColumnをTarget.Rowに変更してください。
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
表示できる年数を変更する
カレンダー上の年数を変更したい場合は、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
以上で祝日が赤くなります。
追記2: ユーザーフォームのテキストボックスで使う
リクエストをいただきましたので、ユーザーフォームへのカスタマイズ方法を紹介した動画を作りました。
テキストボックス用にコピペするコード
標準モジュール「M_CalendarSetting」をダブルクリックして開き、一番下の空いている部分に下記をコピペします。
Public Sub setCalendarDateForTextBox(ByVal tgtTxb As MSForms.TextBox)
'## カレンダーで選択した日付をテキストボックスに入力する
If IsDate(tgtTxb.Value) = False Then '日付が入ってなければ
g_cldCurrentDate = Date '今日の日付を格納
Else
g_cldCurrentDate = tgtTxb.Value 'テキストボックスの日付を格納
End If
F_Calendar.Show 'カレンダーを開く
If g_isCldCancel = True Then Exit Sub 'キャンセル（バツボタンで閉じられた）なら終了
tgtTxb.Value = g_cldPickedDate 'クリックされた日付を上書き
End Sub
その後、任意のユーザーフォーム上に作成したコマンドボタンのクリックイベントから、上に書いたプロシージャをCall setCalendarDateForTextBox(引数)のように呼び出します。引数にはカレンダーの日付を入力したいテキストボックスを設定してください。動画のほうで詳しく説明しています。
追記3: 年を和暦にする
カレンダーの「〇〇」年の部分を、「2003」→「令和5」のような和暦表示にするカスタマイズです。「F_Calendar」モジュール内のコードです。
「UserForm_Initialize」プロシージャの以下のハイライト部分を書き換えます。
Private Sub UserForm_Initialize()
'## フォーム読込時
Dim i As Long '汎用変数
g_isCldCancel = False 'キャンセルフラグをFalseにしておく
For i = -3 To 3 '前後3年分の年をリストに追加
Me.cmb_year.AddItem Format(DateAdd("yyyy", i, g_cldCurrentDate), "ggge")
Next i
For i = 1 To 12 '月をリストに追加
Me.cmb_month.AddItem i
Next i
Me.cmb_year.Value = Format(g_cldCurrentDate, "ggge") '年を指定
Me.cmb_month.Value = Month(g_cldCurrentDate) '月を指定
End Sub
「setCalendar」プロシージャの以下のハイライト部分を書き換えます。
Private Sub setCalendar()
'## カレンダーの作成と表示
Dim i As Long '汎用変数
If Me.cmb_year.Value = "" Or Me.cmb_month.Value = "" Then Exit Sub '年か月どちらか入ってなければ中止
Dim yy As String '年取得
yy = Me.cmb_year.Value
Dim mm As Long '月取得
mm = Me.cmb_month.Value
'略
Dim n As Long '月はじめの位置用変数
n = Weekday(yy & "年" & mm & "月" & "1日") - 1 'その月の1日の曜日番号に、-1したもの
Dim endDay As Long '月末日用変数
endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "年" & mm & "月" & "1日"))) '算出
'略
End Sub
「putTgtDate」プロシージャの以下のハイライト部分を書き換えます。
Private Sub putTgtDate(ByVal i As Long)
'## グローバル変数に取得した日付をセットする
If Me("lbl_day" & i).Caption = "" Then Exit Sub 'ラベルが空だったら中止
g_cldPickedDate = Me.cmb_year.Value & "年" & Me.cmb_month.Value & "月" & Me("lbl_day" & i).Caption & "日" '日付を生成して変数に格納
Unload Me 'カレンダーを閉じる
End Sub
以上でカレンダーの表示は和暦になりますが、セルの表示は別です。該当のセルに対して「セルの書式設定」で「分類」を「日付」、「カレンダーの種類」を「和暦」にするなど、お好みのものへ変更してください。
ExcelVBAに興味をお持ちの方は、こちらの記事もどうぞ！
- これからExcelのマクロを始めたいという方に！簡単な練習問題作りました。
- 私がExcelVBAでよく使う便利なコード・スニペットまとめ
- プログラム初心者さんへ贈る、エラーが起きたら試してみて欲しいこと
- ExcelVBAのクラスモジュールって何？という人向けの使い方まとめ
書籍を執筆しています。
![[ExcelVBA] Excelの表を元の書式を保持してPowerPointへ貼り付ける](https://ateitexe.com/wp-content/uploads/2021/02/210223eye.png){kind=small}
![[ExcelVBA]PowerPointの指定したスライドへExcelグラフを最背面で貼り付ける](https://ateitexe.com/wp-content/uploads/2012/10/121004eye.jpg)
57件のコメント
カレンダー起動時の日付を今日ではなく、excelの表の中で一番最後の日を基準にするにはどうしたら良いですか？
コメントありがとうございます。表を指定のセル範囲と仮定して、セル範囲内の日付で一番大きいものを起動時の初期値にする方法を考えてみました。
インポートした標準モジュール「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失礼します。ありがたく使用させていただこうとしている者なのですが、
結合したセルをターゲットにしたい場合はどうすればいいですか？
コメントありがとうございます。結合セルで試したところ、入力済みの日付を認識できない問題がありましたので、修正して更新いたしました。再度ダウンロードしてお試しください。自分では結合セルで使ったことがなかったので思わぬバグを発見させていただき、ありがとうございました。
調べて調べて調べまくってこちらに辿り着くことができました。
とても素晴らしいものを与えてくださりありがとうございます。
以下対応方法などお分かりでしたら教えてもらうことはできますか？
・祝日の反映は可能なのか。
・テーブル機能に使おうとしていて、最初のセルには反映できるのですが、追加行のセルへの対応がわかりません。
コメント&暖かいお言葉を、ありがとうございます。
祝日対応ですが、外部APIを利用すれば不可能ではなさそうです。私も興味があるので作ってみようかと思いますので、少々お時間をください。ただ、外部サービスを利用するので永続的ではないこと、動作が遅くなること、トラブルなどに対して無保証であることをご了承ください。
> テーブル機能に使おうとしていて、最初のセルには反映できるのですが、追加行のセルへの対応がわかりません
こちらの件は、テーブルに対して行列の挿入を行って試してみたのですが、現象の再現ができませんでした。再現できないことには対処ができず、申し訳ありません。
お返事ありがとうございます。
需要がありそうな際のご対応で大丈夫ですので、何卒ご無理なさらずにお願い致します。
最後に一つ、紹介されている列指定について複数の列はどのように指定したらいいのでしょうか？
例えば、A列、C列、E列に指定したいなどの時です。もしくはA列～C列に指定などの時です。
お忙しいところ恐縮ですが是非ご回答頂ければ幸いです。
祝日対応、本文に追記しましたので見てみてくださいね。
列指定は、例では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 SubPrivate 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お返事が遅くなってしまってすみません。
2点とも対応してくださりありがとうございます。
とても参考になり、助かります！
ご返信ありがとうございます。お役に立てて光栄です！
ターゲットのセルが結合セルだった場合に対応（2022/11/4）となっておりますが、結合セルで反応しません。
対処方法を教えてください。
コメントありがとうございます。Windows10/11、Microsoft365のExcelで動作することを確認しております。OSやOfficeのバージョンが古い場合、一部動作しない可能性があります。Microsoft365をお使いの場合、Officeを最新バージョンへアップデートしてください。また、新規ブック状態から試して、拡張子は.xlsではなく.xlsmで動くかどうかお試しください。（既存ブックだと先に組み込まれている環境が動作に影響する場合があります。）
ダブルクリックした際のコントロールの表示位置が、だんだん下がってしまい３０行以降になるとフレームアウトしてしまします。
コントロール表示がフレームアウトすると、EXCELがフリーズしてしまいます。
コントロール表示位置の調整は可能でしょうか？？
コメントありがとうございます。2022/11/14の更新でダブルクリックしたセルの近くに表示されるようにしたのですが、画面やウィンドウの大きさによって動作が不安定であることがわかりました。デフォルト位置（画面中央表示）へ戻しましたので、お手数ですが最新版をDLし直してお試しください。
当方トリプルモニターで作業しているのですが、複数のセルに指定していまして、ダブルクリックした時にカレンダーの表示がすごい離れたところに表示されてしまいます。入力セルが横にずれればずれる程、隣の画面にカレンダーが現れ、更に隣の画面へと遠くなっていき、隠れてしまったら消すこともできずに強制終了するしかできませんでした。
何か表示を指定のセルに近くする対処法はありますか？
先程質問したものです。
もう一度こちらの操作方法の通常通りでやってみたらちゃんとできていました。
何かそのファイルの中で他の改修をした際におかしくなってしまったようです。
差し支えなければ、セルの近くに置く場合はどこをいじるのか教えて頂きますとこちらでやってみようかと思います。
まとめてのお返事で失礼いたします。上の方の回答と同じく、以前の更新でセルの近くを判定するコードを入れたものが、画面やウィンドウの大きさによって動作が安定しなかったのが原因のようです。デフォルト位置（画面中央表示）へ戻しましたので、お手数ですが最新版をDLし直してお試しください。
何とかこちらに辿り着くことができました。
大変ありがたいサイトです。
当方でも試してみました。
他の方のご意見にもあります通り、結合セルでは反応しません。
単一セルの場合のみ反映します。
併せてPC環境を変えて試してみましたが、いずれも反応しておりません。
こちらで試した環境は、
・Windows 10 Enterprise + Microsoft 365 Apps for enterprise
・Windows 10 Professional + Microsoft Office Standard 2016
またワークシートは既存のファイルを使用して、このサイトからダウンロードしたカレンダーモジュールを反映させております。
当方にVisual Basicの知見がないため、ご面倒をお掛け致しますが、対処法をご教授いただけますと幸いです。
よろしくお願い致します。
あたたかいお言葉、ありがとうございます！ 結合セルの件、以前コメントをいただいてからできる限り環境を変えて試しているのですが、どうしても「結合セルで反応しない」現象に巡り逢うことができずにおります、すみません…。しかしながら、複数の方からのご報告があるので少なくない現象なのではと思っております。一応のご確認ですが、新規ブックで試しても反応しない、ということでよろしいでしょうか？（既存ブックだと先に組み込まれている環境が影響する場合があるため）
現状だと手詰まり状態でして、もしもよろしかったらメールで詳細をお聞かせ願えませんでしょうか？ お問い合わせのメールフォームからご連絡をいただけますと幸いです。よろしくお願いいたします。
素晴らしいソフトを公開していただきありがとうございます。
娘に依頼されて、EXCEL VBAでデータの入力・検索・修正・削除・印刷ができるコードを書いております。
任意のセルへのカレンダー入力はできましたが、ユーザーフォームからの入力において、テキストボックスへのカレンダー入力コードがわからず、ネットで探してはみたのですが、なかなか見つかりません。
お暇な時で結構ですので、ご指導いただけると幸甚です。
余談ですが、娘は現在産休でじかに帰ってきております。わたくしは７０歳を過ぎましたが、ボケ防止にACCESSで簡単なソフトを作っておりましたが、EXCEL VBAを知り、その素晴らしさにはまりました。
嬉しいお言葉、ありがとうございます。ExcelもAccessも楽しいですよね！ その楽しみの一助になれて光栄です。元気な娘さん&お孫さんにお会いできること、お祈りしております。
実は元々ユーザーフォームとテキストボックスで使うために作ったカレンダーだったのですが、セルのほうが汎用的かなと変更したので、需要をいただけて嬉しいです。ここからのカスタマイズだと工程が多いので、せっかくなのでYouTubeのほうで続きの動画として作らせていただこうかと思います。少々お待ちくださいませ。（追記：動画作成しました！）
お世話になります。
とてもいいものをありがとうございます。仕事が捗ります。
結合セルで使えない現象ですが、A1：A2の結合セルで使いたいときに、特定のセルででご紹介されていたコードのセル指定部分を$A$1のまま使っていると発生しました。私は初心者なので試行錯誤してどうにか$A$1:$A$2に書き換えて使用することができました。他の失敗談としては＄a$1のように小文字だとできなかったです。
私以外の初心者の助けになればと思います。
他にはドロップダウンリストで日付を選択できるセルと併用して使いたいと思ったのですが、そのシートに保護をかけるとカレンダーが起動できませんでした。
以上、windows10のexcel2010の報告でした。
【「特定セルの条件をつけているときに」結合セルが反応しない】ということだったんですね！！？ 本当にありがとうございます、条件をつけない状態で試していたのでまったく再現ができずに途方に暮れていました。。おっしゃるとおり、単一セルは「$A$1」の形ですが、結合セルは「$A$1:$A$2」の形で取得されるので、結合セル用の条件を書かないと起動しません。取り急ぎ、本文にも追記させていただきます。これでほかの方も解決すると良いのですが……。
多くの動作と掛け合わせると競合が起きてしまう可能性は十分にありますので、組み合わせてダメだったら、相性が悪かったんだなと思っていただけますとありがたいです。色々試していただいて、さらに暖かいお言葉&情報をご提供くださって本当にありがとうございます。
YouTubeから辿り着きました。
デフォルトで搭載してほしいくらい、デザインも機能もすべて気に入ってます！
一点お聞きしたいのですが、以下のような使い方は出来るのでしょうか…？
1. ユーザーフォーム上のコマンドボタンをクリックすると、このカレンダーコントロールが表示される
↓
2. 日付をクリックすると、ユーザーフォーム上に設置してあるテキストボックスに日付が入る
1については、シートモジュールにコピペするコード「Call setCalendarDateForCell(Target)」を、コマンドボタンクリック時のPrivate Sub内に貼り付ければ良さそう(?)ですが、2のやり方が分からず、、、
VBA歴が短いので、基本的なことでしたらすみません。ご助言いただけますと幸いです。
ご視聴&コメントありがとうございます、気に入っていただけて嬉しいです！ ユーザーフォームでもお使いいただけます。同じご要望をいただいておりまして、続きの動画を作っているところなので、できたら本文に追記いたしますね。少々お待ちくださいませ。（追記：動画作成しました！）
動画拝見しました〜！
まさに求めていたものそのものでした！
声も大変聞きやすく、チャプターや字幕なども便利で分かりやすく、すぐ高評価つけちゃいました！
今後も楽しみにしております！
ご覧いただき、ありがとうございます！ 動画はまだ始めたばかりで「こんな感じでいいのかな…？」と不安に思いながらやっているので、そう言っていただけてとっても嬉しいです！
先日コメントした者です。
新情報のご提供ありがとうございます。
私の方でも結合セルの対応を試してみました。
結合セルの場合は、結合しているセルの範囲を指定することで解決することが確認できました。
また試した環境は以下です。
・Windows 10 Enterprise + Microsoft 365 Apps for enterprise
・Windows 10 Professional + Microsoft Office Standard 2016
・Windows 10 Professional + Microsoft Office Professional Plus 2021
この度は大変お世話になりました。
ありがとうございました。
フィードバックありがとうございます！ 解決して安心しました～！！
活用させていただいてます！
フォーム起動時に年数が1899年の12月となってしまい、更に12月の12の部分が選択された状態で起動してしまうのですが、何が原因なのでしょうか？
コメントありがとうございます。おそらく、なんらかの原因で数値の0をシリアル値と判定しているものと思われます。該当のブックで、セルにゼロが入っていて表示形式が日付、のような設定になっていないかご確認ください。オプションの詳細設定で「ゼロ値のセルにゼロを表示する」のチェックが外れていると、0が入っていても表示されません。
また、月のコンボボックスが選択されているのは仕様です。操作可能な「年」「月」コンボボックス、または月移動のスピンボタンのどれかにフォーカスがあたって起動するので、便宜上「月」にしています。コンボボックスのフォーカスは文字が反転して嫌な場合は、VBEのオブジェクト表示でスピンボタンの「TabIndex」プロパティを「0」にすると、起動時のフォーカスをスピンボタンにできます。
初めましてOhideと申します。
まだVBAを始めて2ヶ月の者ですが、ｶﾚﾝﾀﾞｰからの日付選択がしたくこちらのｻｲﾄに辿り着きました。
動画は解りやすい解説で大変有難う御座います。
それで質問なのですが、CalendarSetup_221205.zipをVBAにｲﾝﾎﾟｰﾄし祝日対応(ﾈｯﾄ接続版?)は
ｶﾚﾝﾀﾞｰに反映するのですが、ﾈｯﾄ接続せず休日ｼｰﾄ版でやりたく思い後日のﾌﾞﾛｸﾞでupされています
ﾌﾟﾛｸﾞﾗﾑを入れたのですが途中で停止してしまいます。
DLしましたﾌﾟﾛｼｰｼﾞｬと、”前回書いてるはず”のﾌﾟﾛｼｰｼﾞｬの内容が違う為？か上手くいきません。
助言をいただけますでしょうか。 よろしくお願いします。
はじめまして、コメントありがとうございます。オフラインの休日シート版というのは、大昔に書いたこの記事（2014/8/7公開）のことですね。これは、その前の記事（2014/8/4公開）で紹介しているコードに追記する前提で書いています。過去のものは「カレンダーをフォームからすべて自作してみよう」というコンセプトで書いたのですが、その後だいぶ経ってから「難しいところはわからなくてもいいから、かんたんシンプルにサクッと使える」方向性で2022年に書き直したのが、このページです。そのため、過去のものとコードが異なっています。
オンラインAPI版があれば休日シート版は需要ないかなと思って書かなかったのですが、掘り起こしてチャレンジしていただいてありがとうございます。シート構造は当時の記事の通り作っていただいて、このページからDLできるバージョンへの対応コードを下に書いておきます。「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 n As Long '月はじめの位置用変数 n = Weekday(yy & "/" & mm & "/" & 1) - 1 'その月の1日の曜日番号に、-1したもの Dim endDay As Long '月末日用変数 endDay = day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1"))) '算出 Dim ws_h As Worksheet '休日情報のシート用変数 Set ws_h = Sheets("休日リスト") Dim fnd As Range, hasData As Boolean, row_h As Long Set fnd = ws_h.Columns("A").Find(yy) '年を検索 If Not fnd Is Nothing Then '年が見つかったら月のチェック row_h = fnd.Row + mm - 1 If ws_h.Cells(row_h, 2) = mm Then hasData = True '該当月があったらフラグを立てておく End If 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 hasData Then '休日シートに該当月があれば If ws_h.Cells(row_h, i + 2) = 1 Then .ForeColor = vbRed '該当日が1なら文字色を赤 End If End With Next i End Subなお、当時の記事にもあるように「休」なら赤、「出」なら黒にしたい場合は上の47～49行目を以下のようにしてください。
こんばんはOhideです。
*yukoさん過去のﾌﾟﾛｸﾞﾗﾑなのに、迅速な対応誠にありがとうございます。
上記のﾌﾟﾛｸﾞﾗﾑで無事!いけました!!
有難く使わせて頂きます。
また勉強させて頂きますので宜しくお願い致します。
フィードバックありがとうございます！ ちゃんと動いてよかったです～！！
こんにちは。Windows10へとver.が変更になり、DateAndTimePickerが使えなくなり、困り果ててこちらへたどり着きました。
とても詳しく説明されているので利用させていただきました。
ご説明の通りにコピーさせていただき、カレンダー表示したいエクセルのセルをダブルクリックしました。
「コンパイルエラー：プロジェクトまたはライブラリーがみつかりません」表示され、
「M_CalendarSetting」
Public Sub setCalendarDateForCell(ByVal tgtRange As Range) ←黄色く表示
‘## カレンダーで選択した日付をテキストボックスに入力する
If IsDate(tgtRange.Cells(1.1).Value) = False Then ‘日付が入ってなければ
g_cldCurrentDate = Date ‘今日の日付を格納 ← Date が青く表示
VBを最近勉強しはじめたばかりで何がたりないのかわかりません。
初級の初級とおもわれますがご説明いただけますでしょうか。
よろしくお願いいたします。
コメントありがとうございます。おそらく個々のPC環境によるものと推測され、同様のエラーを再現することができないためお力になれず申し訳ありません。ただ、エラー箇所と内容から関数のライブラリ参照がうまくいっていないのかな？ という印象を受けました。参考になりそうなリンクを貼っておきますので、お試しください。
丁寧な回答ありがとうございます。
参考に頂いた内容を検証してみましたがうまくできませんでした。
やはり、PC環境がうまくできていないよう気がします。
Windows10の再インストールをしなおしてみます。
ありがとうございました。
フィードバックありがとうございます。OSのほか、Officeの修復や再インストールも効果があるかもしれません。また、新規ブックで動くのであれば、既存ブックに組み込まれている環境との相性の問題も考えられます（すでにお試しでしたらすみません）。解決できることをお祈りしております！
素敵なプログラムを公開頂きありがとうございます。
和暦表示にするにはどこを変更したら良いか教えていただけますでしょうか。
(「ExcelVBAでカレンダーコントロールを自作する」の記事も拝見しましたが分からず恐縮です)
コメントありがとうございます。こちらも昔の記事にあったものですね。ちょっと修正箇所が多かったので、本文のほうに追記しましたのでご覧ください。
早々のご対応頂き感謝申し上げます。
今後の業務に活かさせて頂きたく存じます。
フィードバックありがとうございます！ お役にたてて光栄です～！
素晴らしいツールを公開していただきありがとうございます。
カレンダーから日付を選択できるようになって業務の効率化に大変役立ってます。
1点教えて頂きたいのですが、カレンダーの下部に今日の日付を入力できるようなボタンを追加するにはどのようにしたら出来ますでしょうか？ご教授をお願いいたします。
嬉しいお言葉、ありがとうございます。現在は、セルが空だった場合は今日の日付に枠が付きますが、それとは別に今日の日付専用のボタンがほしいということでしょうか？ 今日ではない年月が表示されているときでも今日の日付を入れたいという意図ですかね？ 今日の日付専用ボタンもできますが、別の年月が表示されているときに今月へ移動するボタン、ではどうでしょうか？
回答有難うございます。
よく考えればカレンダーとは別にボタンを追加して今日の日付を入力するマクロを設定するだけでした。お騒がせしました。
フィードバックありがとうございます。自己解決がいちばん勉強になると思ってるので、答えが出て嬉しいです！
質問させていただきます。
初心者です。
ダブルクリックではなく、シングルクリックでカレンダーを表示させるには
どうしたらよいでしょうか？
☆☆動画も拝見しました。
なかなかピンと来るものが見当たらず困っていたのですが、
こちらを見つけた時は「コレコレ！」と思わず声が出てしまいました！
まさに求めていたものでした！
わかりやすくて初心者の私にも上手くできて感激しました。
ありがとうございます！
コメント&嬉しいお言葉ありがとうございます。
「シートモジュールにコピペするコード」の最初の行に書いてある「Worksheet_BeforeDoubleClick」は、「ワークシートをダブルクリックしたとき」を意味しているのですが、利用できるイベントはあらかじめ決まっていて、「Worksheet_BeforeSingleClick」というものはありません。代わりとするならば「Worksheet_SelectionChange（選択セルが変更されたとき）」が考えられます。以下のように書きます。
ただしこのイベントはシングルクリックで選択したときはもちろん、キーボード操作でセルを移動したときもその都度実行されてしまうのでご承知ください。「特定のセルだけカレンダーを起動」するカスタマイズを加えたほうがよいと思います。
分かりやすい解説・動画で勉強させていただきありがとうございます。
質問させていただきたいのですが，カレンダーからテキストボックスに日付を入力した際にテキストボックス内の表示も和暦にするにはどうしたらいいのでしょうか？
また、日付の後に曜日を追加することも出来るのでしょうか？
大変恐縮ですが，御指導のほどよろしくお願いします。
コメントありがとうございます。「テキストボックス用にコピペするコード」として、「M_CalendarSetting」モジュールに追加した「setCalendarDateForTextBox」プロシージャのハイライト部分を以下のようにしてみてください。
Public Sub setCalendarDateForTextBox(ByVal tgtTxb As MSForms.TextBox) '## カレンダーで選択した日付をテキストボックスに入力する If IsDate(tgtTxb.Value) = False Then '日付が入ってなければ g_cldCurrentDate = Date '今日の日付を格納 Else g_cldCurrentDate = tgtTxb.Value 'テキストボックスの日付を格納 End If F_Calendar.Show 'カレンダーを開く If g_isCldCancel = True Then Exit Sub 'キャンセル（バツボタンで閉じられた）なら終了 tgtTxb.Value = Format(g_cldPickedDate, "ggge年m月d日") 'クリックされた日付を上書き End Subなお、曜日も表示したい場合は以下のようにしてください。
Public Sub setCalendarDateForTextBox(ByVal tgtTxb As MSForms.TextBox) '## カレンダーで選択した日付をテキストボックスに入力する Dim tmp As String tmp = tgtTxb.Value 'テキストボックスの値を変数に格納 If InStr(tmp, "(") <> 0 And InStr(tmp, ")") <> 0 Then 'カッコがあったら tmp = Left(tmp, Len(tmp) - 3) '後ろから3桁(曜日)を除去 End If If IsDate(tmp) = False Then '日付と判定されなかったら g_cldCurrentDate = Date '今日の日付を格納 Else g_cldCurrentDate = tmp '日付を格納 End If F_Calendar.Show 'カレンダーを開く If g_isCldCancel = True Then Exit Sub 'キャンセル（バツボタンで閉じられた）なら終了 tgtTxb.Value = Format(g_cldPickedDate, "ggge年m月d日(aaa)") 'クリックされた日付を上書き End Sub和暦+曜日だと文字数が多くなるのでテキストボックスの横幅は広めにしたほうが良さそうです。お試しください。
素早い対応と回答ありがとうございました！
テキストボックス内の表示も曜日も無事にいけました！
しっかりと業務に活用させていただきます！
ちゃんと動いてよかったです～！ フィードバックありがとうございました！！
こんにちは、カレンダーコントロールを探していて辿り着きました。
年の表示を「yyyy（ggge）」に変更して使っています。
とても有用なコードを提供して頂き感謝します。
別件ですが、
結合セルを認識しない件については
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address “$A$1:$B$2” Then Exit Sub ‘A1:B2の結合セル以外なら終了
Call setCalendarDateForCell(Target)
End Sub
ではなく
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range(”A1:B2”)) Is Nothing Then Exit Sub ‘A1:B2の結合セル以外なら終了
Call setCalendarDateForCell(Target)
End Sub
で行えないでしょうか
Target.Addressはうまく拾えない事がある様な記事を見た事があって私はIntersectを使用しています。
記事があれば良いのですが失念しており見つけられなかったです。
ご参考までに
コメント&情報ありがとうございます。こんな方法もあるのですね！ たいへん勉強になりました。ありがたく本文にも追記させていただきます。
素晴らしいプログラムを公開して頂きありがとうございます。
当方初心者でございます。
上記のやり方で、インポートさせて頂いたのですが、やり方がよくないのか
年を選択するコンボボックスが1896年から1902年しか選択できないようになってしまいます。
お忙しいところ申し訳ございませんが、教えて頂きたく思います。
コメントありがとうございます。おそらく、なんらかの原因で数値の0をシリアル値と判定しているものと思われます。該当のブックで、セルに0が入っていて表示形式が日付、のような設定になっていないかご確認ください。オプションの詳細設定で「ゼロ値のセルにゼロを表示する」のチェックが外れていると、0が入っていても表示されません。
コメントは承認制ですので、反映までしばらくお待ち下さい。（稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。）
YouTubeでQ&Aコンテンツを企画しています
運営しているYouTubeチャンネルで、ご相談やご質問にお応えする企画を行っています。プログラミングなどでお困りのことがあれば、お問い合わせページからお気軽にご相談をお寄せください。