ダウンロード(「カレンダー入力」用フォーム)

日付の入力形式の統一や、正しい日付を入力させるにはどうすれば良いでしょう。

カレンダー表示から日付を選択することで日付を入力するものです。この前のページで「日付入力」のクラスを紹介しましたが、プロパティ操作ができない状態だし、APIだらけなので導入には抵抗があると思います。「Visual Basic 6.0」時代のものなのでかなり古く、現在には合いません。
昔はOfficeに「カレンダーコントロール」があったのですが、Accessがインストールされていないと動かないし、Office2010からは廃止されたので Microsoftのサポートが現存するバージョンでは利用できないものとなりました。

このページの説明は、既存の「カレンダーコントロール」的なものを探すのではなく「独自に作ってしまえ！」です。
早い話が、自己に「カレンダーコントロール」のような「カレンダー入力フォーム」を組み込めればある程度は解決できます。独自に作成するのであれば、祝日名の表示やキーボードの矢印キーでの日付移動、「月曜始まり」のカレンダー表示など、機能も高められます。
そのカレンダー部分は作成済みでこのページからダウンロードできるので、あとは機能の実装部分を考えて下さい。

さらに祝日の変更が発生した時にプログラムの修正なく対応できるように「祝日パラメータシート」で祝日の定義ができるようになっています。「会社休日」として年末年始で祝日に当たらない日を休日表示させることもできるようになっています。
祝日判定部分の説明は「年間カレンダーの作成２」をご覧下さい。

VBA初心者向けに「アドイン版」を用意しました。このページのサンプルは「VBA中・上級者でないと理解できない」というご意見をいただいておりました。
確かにこのページの長さ(記述ボリューム)だけ見ても初心者の方だと「うんざり」されてしまうかもしれません。
そこで次頁に「アドイン版」を用意し、カレンダー機能のほとんどをアドイン側に格納してみました。

利用者が実際にカレンダー機能を実装させるための「学習」を含む作業負荷を極力軽減させるべく、ユーザーフォーム呼び出しなど一部の機能は制限させていただきましたが、ワークシート上の日付入力セルからのカレンダー呼び出しについて簡単に実装できるようになっております。

これから新たにカレンダー機能を検討されるようでしたら、実装作業負荷が少ないという点から見ても、次頁の「アドイン版」を先にご覧いただくと良いと思います。

2022年12月にアップデートを行ないました。以前からのサンプルではユーザーフォーム上の日付項目から「カレンダー入力フォーム」を起動する場合、日付項目右端の▽のクリック以外にF4キーでも起動できたのですが、ワークシート上では「特定キー打鍵」によるイベントがないことから対応は行なっていませんでした。

この「カレンダー入力フォーム」はVBA初心者での利用者も多く、これをきっかけにマクロに手を付けたという方もいらっしゃいます。「カレンダー入力フォーム」の主機能部分はこのページのサンプルから目的のワークブックにコピーして持ち込めば利用できるようにしており、「カレンダー入力フォーム」の起動部分のみコード記述して実装いただくものですから、コード記述の量は増やしたくないということがありました。

しかし、ワークシート上で特定キー打鍵での「カレンダー入力フォーム」起動についてはリクエストも何件かいただいておりますので、これを機に実装に加えました。以前からこの「カレンダー入力フォーム」を利用いただいている方への変更については、コード説明の最初の方に説明を緑色文字でまとめてあります。

なお、追加した「アドイン版」についてもワークシートからのF4キーでのカレンダー表示に対応しております。

シート上、又はテキストボックス上で利用できるものを考えてみました。

シート上なら、該当セルをダブルクリックした時点で「カレンダー入力フォーム」が表示されるように利用できます。

(画像をクリックすると、このページのサンプルがダウンロードできます)
このサンプルでは、シート上の罫線で囲ったセルを日付入力セルとして動作するようにしているので、他のセルをダブルクリックしても「カレンダー入力フォーム」は表示されません。対象セルをダブルクリックするか、対象セル選択状態でF4キーを押した時だけ、直下に「カレンダー入力フォーム」が表示されて、その「カレンダー入力フォーム」で日付を選択するとその日付がセルに入力されます。
※表示されたカレンダーが不要になった場合は[×]をクリックするか、Escキーを押して下さい。
マウス移動に連動してステータス領域に日付や祝日名が表示されます。

祝日計算のモジュールを搭載しているので、祝日は赤太字で表示されてマウスカーソルを当てると祝日名も表示されます。
上端の左右にある矢印をクリックして前後の月に移動できますが、それ以外に年月表示部分をクリックすると年月のコンボのプルダウンが現われて選択できます。

このようにマウス操作では充分な機能になっていると思いますが、これ以外にキーボードでの日付選択ができるようになっています。キー操作で現在日付の青いカーソルを移動させて、Enterキーで決定するという操作です。各キーの機能は以下のようになっています。

押下キー	動作機能
→、Tab、＋、６（テンキー）	翌日に移動します。（表示範囲を超えると自動的に翌月に移動します。）
←、Shift+Tab、－、４（テンキー）	前日に移動します。（表示範囲を超えると自動的に前月に移動します。）
↓、２（テンキー）	翌週の同曜日に移動します。（表示範囲を超えると自動的に翌月に移動します。）
↑、８（テンキー）	前週の同曜日に移動します。（表示範囲を超えると自動的に前月に移動します。）
Home	表示月の月初（１日）に移動します。
End	表示月の月末（末日）に移動します。
PageDown	翌月に移動します。
PageUp	前月に移動します。
F12	翌年同月に移動します。
F11	前年同月に移動します。
Enter	日付を決定してカレンダー入力フォームを閉じます。
Esc	キャンセルしてカレンダー入力フォームを閉じます。

ユーザーフォーム上なら、テキストボックスの右端の▼をクリックした時点で「カレンダー入力フォーム」が表示されるように利用できます。

画面イメージだとコンボボックスに見えますが、これはテキストボックスです。初期化時にドロップダウンボタンをShowDropButtonWhenプロパティで表示させています。 (このプロパティはデザイナ段階では表示されません)
ユーザーフォームの場合はカレンダーの表示位置のLeft、Topを指定して表示させるようになっており、この指定を行なわない場合はスクリーン中央に表示されるようになっています。このLeft、Topはユーザーフォーム自身のLeft、Topに対して、そのユーザーフォーム内のテキストボックスまでのLeft、Topを加算します。
但し、グループボックスなどの「コンテナ」の上にテキストボックスが載っている場合は、テキストボックスのLeft、Top値はそのグループボックスの起点からの位置なので、ユーザーフォームからの位置の算出にはグループボックスのLeft、Topを加算することになります。
さらに、ユーザーフォームやグループボックスについては外から見たLeft、Topと、内側の起点位置にフレーム部分の「ズレ」があり、特にグループボックスはタイトルの分の高さのズレが大きいといえますが、この分は調整値として動作確認して加算して下さい。
なお、元フォームの日付項目テキストボックスにカーソルがある場合は、マウスでテキストボックスの右端の▼をクリックしなくても、F4キーで「カレンダー入力フォーム」を表示させることができます。
初期設定を変更することで、このように「月曜始まり」のカレンダー表示に変更することができます。

企業内でのカレンダーは「月曜始まり」で用いることがかなり多いので、通常の「日曜始まり」と切り替えて「月曜始まり」での表示ができるようになっています。どちらを用いるのかはコード上の定数値の「１」を「２」に替えるだけです。

[コード実装説明] マクロは初級の方にも組み込みやすいように配慮してあります。

今回より「祝日判定処理」についてもソースコードの変更は行なわずに「祝日パラメータ」シートの登録の変更で対応できるようになったので、実際にワークシートの日付セルからの呼び出しか、ユーザーフォームの日付テキストボックスからの呼び出しか、その呼び出し部分の記述の実装のみマスターしていただければこれらの機能は実現できるようになりました。

カレンダーの呼び出し部分で実際に記述実装していただくのは、今回のサンプルでは以下のコードモジュールです。

ID	内容
modTestCalendar5 (Module)	標準モジュールの追加を行なって必要なコードを書き込みます。標準モジュールの追加を行なうと当初は「Module1」といった名前になるので、名称はこのままでも構いません。内容はカレンダー呼び出しを行なう対象となるワークシート名とセルアドレスの定数宣言のみです。 2022年12月の変更(F4対応)前はこのモジュールはありません。定数宣言はワークシートのクラス側に記述していました。
ThisWorkbook (Class)	ワークブックには既に存在するクラスモジュールで、開いて中に必要なコードを書き込みます。ワークシート上からF4キーによるカレンダー呼び出しなど、以下のプロシージャがあります。 ○Workbook_Open 初回のクラス初期化を行なうプロシージャ呼び出しを行なう。この記述がなくても初回のカレンダー呼び出し時に初期化されるようになっている。 ○Workbook_WindowActivate Application.OnKeyによるF4キー打鍵時のイベント的処理の設定 ○Workbook_WindowDeactivate Application.OnKeyによるF4キー打鍵時のイベント的処理の解除 ○OnkeyF4Proc F4キー打鍵時に行なう実際の処理呼び出し記述 2022年12月の変更(F4対応)前は「Workbook_Open」で初回クラス初期化のみ記述していました。「Workbook_Open」以外は2022年12月の変更(F4対応)での追加になります。
Sheet1 (Class)	存在するワークシートのそれぞれに存在するクラスモジュールで、開いて中に必要なコードを書き込みます。カレンダーに関して必要なプロシージャは「Worksheet_BeforeDoubleClick」のみで、セルのダブルクリックで発生するイベントです。イベントはどのセルでも発生するので、対象セルか判断した上でカレンダーを呼び出すようにします。 2022年12月の変更(F4対応)前はこのクラスの先頭にカレンダー呼び出しを行なう対象となるセルアドレスの定数宣言がありましたが、ThisWorkbookからの参照とを共通化するため、標準モジュールに移動しました。
UserForm1 (UserForm)	ユーザーフォームからのカレンダー呼び出しの記述を説明するためのサンプルです。ユーザーフォームを利用しない場合は必要ありません。 2022年12月の変更(F4対応)前からの変更はありません。

これらのサンプルを理解していただき、実際のコード記述はサンプルからコピーした上で必要な変更を加えて下さい。

上記以外にカレンダーの主機能部分で、今回のサンプルから実行環境に移していただく必要があるものは以下の通りです。
これらは実装段階でコード記述の変更は不要です。

ID	内容
UF_Calendar5	カレンダー表示フォーム(UserForm)
modCalendar5	カレンダー表示呼び出しモジュール(Module)
clsUF_Cal5Label1	カレンダー表示フォーム上のラベルのイベントクラス①(Class)
clsUF_Cal5Label2	カレンダー表示フォーム上のラベルのイベントクラス②(Class)
modAboutCalendar2	カレンダー算出呼び出しモジュール(Module)
clsAboutCalendar2	祝日を含めたカレンダー算出本体クラス(Class)
祝日パラメータ	「祝日パラメータ」ワークシート(Worksheet)

上記のモジュールから「カレンダー入力フォーム」を呼び出す記述は、それぞれ「modCalendar5」の中の以下のプロシージャを呼び出しています。

プロシージャ	内容
ShowCalendarFromTextBox2	ユーザーフォームのテキストボックス(MsForms.TextBox)から表示させる [引数] ①対象テキストボックス(Object) ②カレンダーフォームの表示位置：横(Long) ※Option ③カレンダーフォームの表示位置：縦(Long) ※Option ④カレンダーフォームのCaption(String) ※Option、デフォルトは"日付選択" ⑤値を返す時のFormat(String) ※Option、デフォルトは"YYYY/MM/DD"
ShowCalendarFromRange2	セル(Range)から表示させる(表示位置自動算出) [引数] ①対象セル(Object) ②カレンダーフォームのCaption(String) ※Option、デフォルトは"日付選択"

プロシージャ

内容

ShowCalendarFromTextBox2

ユーザーフォームのテキストボックス(MsForms.TextBox)から表示させる
[引数]
①対象テキストボックス(Object)
②カレンダーフォームの表示位置：横(Long)    ※Option
③カレンダーフォームの表示位置：縦(Long)    ※Option
④カレンダーフォームのCaption(String)       ※Option、デフォルトは"日付選択"
⑤値を返す時のFormat(String)                ※Option、デフォルトは"YYYY/MM/DD"

ShowCalendarFromRange2

セル(Range)から表示させる(表示位置自動算出)
[引数]
①対象セル(Object)
②カレンダーフォームのCaption(String) ※Option、デフォルトは"日付選択"

[コード実装説明] カレンダー呼び出しに関する各モジュールのサンプルコード

[modTestCalendar5(Module)]


'***************************************************************************************************
'   カレンダーフォーム表示テスト                                ※modTestCalendar5(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'22/12/06(1.90)新規作成(シート上でのキー入力に対するカレンダー表示機能追加の対応)
'***************************************************************************************************
Option Explicit
'===================================================================================================
' カレンダー表示関連定数(今回サンプルの例)
'---------------------------------------------------------------------------------------------------
' カレンダー表示対象シート
Public Const g_cnsDateSheet1 As String = "カレンダーフォームの表示"
' シート上の日付セルアドレス
Public Const g_cnsDateCellAdress1 = "$A$1,$A$9,$D$13,$B$17,$G$18,$E$21,$C$25,$H$27:$I$28,$F$30"

'----------------------------------------<< End of Source >>----------------------------------------

カレンダー呼び出しを行なうシート名と対象セルアドレスの定数宣言を配置しています。
複数のモジュールから参照されるため、標準モジュールにPublicスコープで宣言します。
このサンプルでは対象は1シートのみですが、複数のデザインが異なるシートが対象になる場合はそれぞれのシート分を宣言します。

[ThisWorkbook(Class)]


'***************************************************************************************************
'   カレンダーフォーム表示テスト                                ※ThisWorkbookイベント(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/02/18(1.00)新規作成
'18/09/23(1.70)カレンダー関連機能のクラス化対応
'22/12/06(1.90)シート上でのキー入力に対するカレンダー表示機能追加
'***************************************************************************************************
Option Explicit
'---------------------------------------------------------------------------------------------------
' カレンダー表示キー(通常はF4、ユーザーフォームと共通動作)
Private Const g_cnsDateKey As String = "{F4}"

'***************************************************************************************************
'   ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名　：Workbook_Open
'* 機能　　：開くイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月18日
'* 作成者　：井上　治
'* 更新日　：2018年09月23日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Workbook_Open()
    '-----------------------------------------------------------------------------------------------
    ' カレンダー関連関数クラス初期化(祝日パラメータシートがチェック済なら引数Trueを追加) ※初回
    If modAboutCalendar2.FP_InitAboutCalendar Then
        ' カレンダーフォームの表示シート
        ' ※この記述は本サンプル限定
        With Sheet1
            .Select
            .Protect UserInterfaceOnly:=True
            .Cells(1, 7).Value = "祝日パラメータ更新日：" & Sheet2.Cells(1, 12).Text
            .Cells(2, 7).Value = "カレンダーモジュールVer：" & g_clsAboutCalendar.Version & _
                "(" & Format(g_clsAboutCalendar.VerUpdDate, "yy/MM/dd") & ")"
        End With
    End If
    ' 保存済みにする
    ThisWorkbook.Saved = True
End Sub

'***************************************************************************************************
'* 処理名　：Workbook_WindowActivate
'* 機能　　：WindowActivateイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2022年12月06日
'* 作成者　：井上　治
'* 更新日　：2022年12月06日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
    '-----------------------------------------------------------------------------------------------
    ' F4キーを押したら特定プロシージャを起動
    Call Application.OnKey(g_cnsDateKey, "ThisWorkbook.OnkeyF4Proc")
End Sub

'***************************************************************************************************
'* 処理名　：Workbook_WindowDeactivate
'* 機能　　：WindowDeactivateイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2022年12月06日
'* 作成者　：井上　治
'* 更新日　：2022年12月06日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    '-----------------------------------------------------------------------------------------------
    ' F4キー起動プロシージャを解除
    Call Application.OnKey(g_cnsDateKey)
End Sub

'***************************************************************************************************
'   ■■■ 共通プロシージャ(Onkey呼び出し用) ■■■
'***************************************************************************************************
'* 処理名　：OnkeyF4Proc
'* 機能　　：F4キー呼び出し処理
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2022年12月06日
'* 作成者　：井上　治
'* 更新日　：2022年12月06日
'* 更新者　：井上　治
'* 機能説明：F4キー打鍵で呼び出される処理
'* 注意事項：
'***************************************************************************************************
Public Sub OnkeyF4Proc()
    '-----------------------------------------------------------------------------------------------
    ' カレンダー表示対象シートか
    If ActiveSheet.Name = g_cnsDateSheet1 Then
        ' カレンダー表示対象セルか
        If Not Intersect(ActiveCell, Range(g_cnsDateCellAdress1)) Is Nothing Then
            ' カレンダーフォームを起動する
            Call modCalendar5.ShowCalendarFromRange2(ActiveCell)
        End If
    End If
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

4つのプロシージャがあります。
「Workbook_Open」の記述はカレンダー関連関数クラスの起動初回の初期化とカレンダー関連のバージョン表示になります。
カレンダー関連関数クラスの初期化はカレンダーの呼び出し時にも初期化済みかの判断の上で行なわれるので、ここでの記述は必須ではありません。バージョン表示は本サンプルでの要件なので、利用者には任意となります。

「Workbook_WindowActivate」「Workbook_WindowDeactivate」はF4キーで動作するプロシージャの指定／解除を行ないます。ワークシート上では「特定キー打鍵」に関するイベントがないため、Application.OnKeyメソッドを利用しており、必要外の場合の解除を含めて対応が必要です。
呼び出しプロシージャ名を変更しなければ、ユーザー環境への持ち込みでコードを変更する必要は発生しません。

「OnkeyF4Proc」は上記Application.OnKeyメソッドで呼び出し指定される実際のプロシージャです。
F4キー打鍵時にはApplicationレベルで呼び出されてしまうため、シートやセルが処理対象かをチェックした上でカレンダー呼び出しを行ないます。ワークシートイベントとは異なり、イベント発生場所はアクティブシート、アクティブセルで判断することになります。

これらの記述直後では上記イベントが発生しないのでF4キーでの動作は起りません。
ワークブックを開き直す等が必要になります。

2022年12月の変更(F4対応)前は「Workbook_Open」のみでした。
これらのプロシージャがない場合はF4キーでのカレンダー動作は起りません。

[Sheet1(Class)]


'***************************************************************************************************
'   カレンダーフォーム表示テスト                                Sheet1(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/02/21(1.00)新規作成
'18/11/28(1.80)カレンダーフォーム上の各日付ラベルをクラス化(WithEvents)させる対応
'22/12/06(1.90)シート上でのキー入力に対するカレンダー表示機能追加対応
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'* 処理名　：Worksheet_BeforeDoubleClick
'* 機能　　：ワークシートダブルクリッククリックイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2022年12月06日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    '-----------------------------------------------------------------------------------------------
    ' カレンダー表示対象セルか判定
    If Intersect(Target, Range(g_cnsDateCellAdress1)) Is Nothing Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォームを起動する
    Call modCalendar5.ShowCalendarFromRange2(Target)
    ' ダブルクリック動作をキャンセル
    Cancel = True
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

「Worksheet_BeforeDoubleClick」はシート上でのダブルクリックイベントの記述になります。
ワークシートクラス上の記述なのでワークシートは既に特定されており、イベント発生セルが引数「Target」で通知されるのでカレンダー処理の対象セルか判断した上でカレンダーを表示させるという記述になります。
カレンダー処理の後は引数「Cancel」にTrueをセットします。これを行なわないと通常セルでダブルクリックした時のようにセル内容が選択されます。

2022年12月の変更(F4対応)前は対象セルアドレスの定数が先頭に配置されていました。

実際のサンプルには「BTN_ShowUserForm_Click」プロシージャがありますが、ユーザーフォームテストの起動ボタンなので実装利用では必要ありません。

[UserForm1(UserForm)]


'***************************************************************************************************
'   カレンダーフォーム4(日付入力部品)   ※テスト用フォーム      UserForm1(UserForm)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/02/21(1.00)新規作成
'***************************************************************************************************
Option Explicit
'---------------------------------------------------------------------------------------------------
Private Const g_cnsAddLeft As Long = 3                          ' Left調整値
Private Const g_cnsAddTop As Long = 19                          ' Top調整値
Private Const g_cnsAddLeft2 As Long = 4                         ' Left調整値(フレーム用)
Private Const g_cnsAddTop2 As Long = 25                         ' Top調整値(フレーム用)
' ※これらの調整値はWindows10時点の画面で適当に見繕った値です。
' 　二重にフレームが重なった等の場合は別途調整が必要です。

'***************************************************************************************************
' ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名　：TextBox1_DropButtonClick
'* 機能　　：フォーム上のテキストボックスイベント(DropButtonClick)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TextBox1_DropButtonClick()
    '-----------------------------------------------------------------------------------------------
    Dim lngLeft As Long                                             ' 位置(横方向)
    Dim lngTop As Long                                              ' 位置(縦方向)
    ' フォーム+テキストボックスのLeft,Top値から位置を判定
    lngLeft = Me.Left + TextBox1.Left + g_cnsAddLeft
    lngTop = Me.Top + TextBox1.Top + TextBox1.Height + g_cnsAddTop
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォームを起動する
    Call modCalendar5.ShowCalendarFromTextBox2(TextBox1, lngLeft, lngTop)
End Sub

'***************************************************************************************************
'* 処理名　：TextBox2_DropButtonClick
'* 機能　　：フレーム上のテキストボックスイベント(DropButtonClick)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TextBox2_DropButtonClick()
    '-----------------------------------------------------------------------------------------------
    Dim lngLeft As Long                                             ' 位置(横方向)
    Dim lngTop As Long                                              ' 位置(縦方向)
    ' フォーム+フレーム+テキストボックスのLeft,Top値から位置を判定
    lngLeft = Me.Left + Frame1.Left + TextBox2.Left + g_cnsAddLeft2
    lngTop = Me.Top + Frame1.Top + TextBox2.Top + TextBox2.Height + g_cnsAddTop2
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォームを起動する
    Call modCalendar5.ShowCalendarFromTextBox2(TextBox2, lngLeft, lngTop)
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_Initialize
'* 機能　　：ユーザーフォームの初期化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    ' テキストボックスに▼ボタンを表示させる
    TextBox1.ShowDropButtonWhen = fmShowDropButtonWhenAlways
    TextBox2.ShowDropButtonWhen = fmShowDropButtonWhenAlways
    ' デフォルト日付の表示(今日)
    TextBox1.Text = Format(Date, "yyyy/MM/dd")
    TextBox2.Text = Format(Date, "yyyy/MM/dd")
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

サンプルではこのようになっていますが、最低限の利用方法では該当するテキストボックスを引数にして「ShowCalendarFromTextBox2」を呼び出すだけです。
このサンプルでは欲張って、「カレンダー入力フォーム」をテキストボックスの直下に表示させるようにしていますが、これらの指定を省略すれば「カレンダー入力フォーム」はスクリーンの中央に表示されるだけです。
但し、テキストボックスはデフォルトでは、右端の「▼」は表示されないので、フォームの初期化イベント(UserForm_Initialize)で、ShowDropButtonWhenをfmShowDropButtonWhenAlwaysにしておく必要があります。このプロパティはデザイン時にはプロパティボックスには表示されないので、このサンプルのように記述して下さい。
表示位置については、実際にはスクリーン上の位置として「カレンダー入力フォーム」の上端(Top)と左端(Left)を指定するのですが、テキストボックスのこれらのプロパティは「親」となる要素の左上隅をゼロとした値でしかないので、その「親」がスクリーン上のどこに位置するかも判断しなければなりません。しかも、テキストボックスがフレーム上にある場合は「親」となる要素はフレームとなり、そのフレームがフォーム上のどこにあるのかが追加されます。ここでは触れませんが、フレームが２重になっているようなケースもあるでしょう。
さらにやっかいなのは、ウィンドウの境界「枠」と「タイトルバー」「ツールバー」です。Top、Leftのプロパティはこれらを除いた内側の左上を起点とした位置情報なので、ただ加算しても正しい位置にはなりません。
そこで、サンプルではウィンドウの境界「枠」については実測した「適当そうな値」を定数として加算させることにしてあります。

「カレンダー入力フォーム」側のコードも説明しておきます。

ここから下のコードはほとんどの場合改変なく利用できるので、特に理解しなくても構いません。
今回の「カレンダー入力フォーム」は選択元セルもしくはユーザーフォーム上の選択元テキストボックスに日付を返すように作成しているため、日付を選択するかキャンセルしないと元のシート（又はユーザーフォーム）には戻れない「モーダルフォーム」を使っています。一部の要望では、「カレンダー入力フォーム」を表示させたまま別のセルを選択し直すなどの意見がありますが、「日付を返す先」の特定の問題と、ユーザーフォームと兼用(モーダルフォームの上にモードレスフォームを表示することができないというUserFormの仕様)していることもあって、この仕様は変更できません。

組み込むモジュールは上記で説明しましたが、まず「modCalendar5」を紹介します。


'***************************************************************************************************
'   カレンダーフォーム5(日付入力部品)   ※呼び出しプロシージャ    modCalendar5(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/02/21(1.00)新規作成
'18/11/28(1.80)カレンダーフォーム上の各日付ラベルをクラス化(WithEvents)させる対応
'19/10/20(1.90)64ビットWindows対応
'19/12/08(1.95)複数スクリーン対応、スクリーン下端・右端からのはみ出し対応
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsDateFormat = "YYYY/MM/DD"                    ' デフォルトの日付Format
Private Const g_cnsCaption = "日付選択"                         ' デフォルトのCaption
'---------------------------------------------------------------------------------------------------
' フォーム位置制御関連
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const SM_CYSCREEN As Long = 1
Private Const SM_XVIRTUALSCREEN As Long = 76
Private Const SM_YVIRTUALSCREEN As Long = 77
Private Const SM_CXVIRTUALSCREEN As Long = 78
Private Const SM_CYVIRTUALSCREEN As Long = 79
Private Const SPI_GETWORKAREA As Long = 48
'---------------------------------------------------------------------------------------------------
' GetWindowRect用ユーザー定義
Private Type g_typRect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
' 64ビット版判定
#If VBA7 Then
' ■GetDC(API)
Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
' ■ReleaseDC(API)
Private Declare PtrSafe Function ReleaseDC Lib "user32.dll" _
    (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
' ■GetDeviceCaps(API)
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" _
    (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
' ■GetSystemMetrics(API)
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
' ■SystemParametersInfo(API)
Private Declare PtrSafe Function SystemParametersInfo Lib "user32.dll" _
    Alias "SystemParametersInfoA" ( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As g_typRect, _
    ByVal fuWinIni As Long) As Long
#Else
' ■GetDC(API)
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
' ■ReleaseDC(API)
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
' ■GetDeviceCaps(API)
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
' ■GetSystemMetrics(API)
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
' ■SystemParametersInfo(API)
Private Declare Function SystemParametersInfo Lib "user32.dll" _
    Alias "SystemParametersInfoA" ( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As g_typRect, _
    ByVal fuWinIni As Long) As Long
#End If

'***************************************************************************************************
'* 処理名　：ShowCalendarFromTextBox2
'* 機能　　：ユーザーフォームのテキストボックス(MsForms.TextBox)から表示させる
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = テキストボックス(Object)
'* 　　　　　Arg2 = カレンダーフォームの表示位置：横(Long)  ※Option
'* 　　　　　Arg3 = カレンダーフォームの表示位置：縦(Long)  ※Option
'* 　　　　　Arg4 = カレンダーフォームのCaption(String)     ※Option、デフォルトは"日付選択"
'* 　　　　　Arg5 = 値を返す時のFormat(String)              ※Option、デフォルトは"YYYY/MM/DD"
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2019年12月08日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub ShowCalendarFromTextBox2(ByRef objTextBox As MSForms.TextBox, _
                                    Optional ByVal lngLeft As Long = 0, _
                                    Optional ByVal lngTop As Long = 0, _
                                    Optional ByVal strCaption As String = g_cnsCaption, _
                                    Optional ByVal strFormat As String = g_cnsDateFormat)
    '-----------------------------------------------------------------------------------------------
    Dim lngFormWidth As Long                                        ' カレンダーフォームの幅
    Dim lngFormHeight As Long                                       ' カレンダーフォームの高さ
    Dim lngScreenRight As Long                                      ' スクリーン右端位置
    Dim lngScreenBottom As Long                                     ' スクリーン下端位置
    Dim lngDPIX As Long                                             ' Dots Per Inch(水平)
    Dim lngDPIY As Long                                             ' Dots Per Inch(垂直)
    Dim lngPPI As Long                                              ' Pixels Per Inch
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォームの大きさ取得
    lngFormWidth = UF_Calendar5.Width
    lngFormHeight = UF_Calendar5.Height
    ' ※以下はExcel2003以前では動作しない
    lngDPIX = FP_GetDPIX
    lngDPIY = FP_GetDPIY
    lngPPI = FP_GetPPI
    '-----------------------------------------------------------------------------------------------
    ' スクリーンサイズ位置の取得
    Call GP_GetScreenPos(0, 0, lngScreenRight, lngScreenBottom)
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォームがスクリーンからはみ出すか(横)
    If (lngLeft + lngFormWidth) * (lngDPIX / lngPPI) > lngScreenRight Then
        ' スクリーン右端に移動(+3は誤差？)
        lngLeft = lngScreenRight * (lngPPI / lngDPIX) - lngFormWidth + 3
    End If
    ' カレンダーフォームがスクリーンからはみ出すか(縦)
    If (lngTop + lngFormHeight) * (lngDPIY / lngPPI) > lngScreenBottom Then
        ' セル上端に移動(+3は誤差？)
        lngTop = lngTop - (objTextBox.Height + lngFormHeight) + 3
    End If
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォーム
    With UF_Calendar5
        .prpTitle = strCaption                              ' タイトル
        .prpEntMode = 1                                     ' 入力モード(0=セル、1=TextBox)
        Set .prpTextBox = objTextBox                        ' 対象TextBox
        .prpDateFormat = strFormat                          ' 日付フォーマット
        ' フォーム表示位置の確認
        If ((lngLeft <> 0) Or (lngTop <> 0)) Then
            ' 指定がある場合はマニュアル指定
            .StartUpPosition = 0
            .Left = lngLeft
            .Top = lngTop
        Else
            ' 指定がない場合はスクリーンの中央
            .StartUpPosition = 2
        End If
        ' カレンダーフォームを表示
        .Show
    End With
End Sub

'***************************************************************************************************
'* 処理名　：ShowCalendarFromRange2
'* 機能　　：セル(Range)から表示させる
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = セル(Object) ※単一セル又は結合した日付用セル
'* 　　　　　Arg2 = カレンダーフォームのCaption(String)     ※Option、デフォルトは"日付選択"
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2019年12月08日
'* 更新者　：井上　治
'* 機能説明：当該セルの下にカレンダーフォームが表示される
'* 注意事項：
'***************************************************************************************************
Public Sub ShowCalendarFromRange2(ByRef objRange As Range, _
                                  Optional ByVal strCaption As String = g_cnsCaption)
    '-----------------------------------------------------------------------------------------------
    Dim lngLeft As Long                                             ' 横位置
    Dim lngTop As Long                                              ' 縦位置
    ' 非結合のセル範囲を選択している時は処理しない
    If objRange.Count > 1 Then
        ' 単一結合セルはOK とする
        If objRange.Address <> objRange.Cells(1).MergeArea.Address Then Exit Sub
    End If
    '-----------------------------------------------------------------------------------------------
    ' ユーザーフォーム表示位置取得
    Call FP_GetFormPosition(objRange, UF_Calendar5.Width, UF_Calendar5.Height, lngLeft, lngTop)
    '-----------------------------------------------------------------------------------------------
    ' カレンダーフォーム
    With UF_Calendar5
        .prpTitle = strCaption                              ' タイトル
        .prpEntMode = 0                                     ' 入力モード(0=セル、1=TextBox)
        Set .prpRange = objRange                            ' 対象セル
        ' フォーム表示位置の確認
        If ((lngLeft <> 0) Or (lngTop <> 0)) Then
            ' 指定がある場合はマニュアル指定
            .StartUpPosition = 0
            .Left = lngLeft
            .Top = lngTop
        Else
            ' 指定がない場合はスクリーンの中央
            .StartUpPosition = 2
        End If
        ' カレンダーフォームを表示
        .Show
    End With
End Sub

'***************************************************************************************************
'　■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：FP_GetFormPosition
'* 機能　　：ユーザーフォーム表示位置取得
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = 対象セル(Object)
'* 　　　　　Arg2 = ユーザーフォームの幅(Long)
'* 　　　　　Arg3 = ユーザーフォームの高さ(Long)
'* 　　　　　Arg4 = スクリーン上の横位置(Long)          ※Ref参照
'* 　　　　　Arg5 = スクリーン上の縦位置(Long)          ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2019年12月08日
'* 更新者　：井上　治
'* 機能説明：セルの真下にフォームを表示させる位置を取得
'* 注意事項：取得できない時は横位置､縦位置ともゼロとなる
'***************************************************************************************************
Private Function FP_GetFormPosition(ByRef objRange As Range, _
                                    ByVal lngFormWidth As Long, _
                                    ByVal lngFormHeight As Long, _
                                    ByRef lngFormLeft As Long, _
                                    ByRef lngFormTop As Long) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim objTarget As Range                                          ' 対象セル(先頭セル)
    Dim objAW As Window                                             ' ActiveWindow
    Dim lngPaneIx As Long                                           ' PaneIndex(0～4)
    Dim lngIx As Long                                               ' ループ用INDEX(Work)
    Dim lngR1C1Left As Long                                         ' 起点セル左端位置
    Dim lngR1C1Top As Long                                          ' 起点セル上端位置
    Dim lngTargetLeft As Long                                       ' 対象セル左端位置
    Dim lngTargetTop As Long                                        ' 対象セル上端位置
    Dim lngScreenRight As Long                                      ' スクリーン右端位置
    Dim lngScreenBottom As Long                                     ' スクリーン下端位置
    Dim lngDPIX As Long                                             ' Dots Per Inch(水平)
    Dim lngDPIY As Long                                             ' Dots Per Inch(垂直)
    Dim lngPPI As Long                                              ' Pixels Per Inch
    FP_GetFormPosition = False
    lngFormLeft = 0
    lngFormTop = 0
    lngPaneIx = 0
    Set objTarget = objRange.Cells(1).MergeArea
    Set objAW = ActiveWindow
    '-----------------------------------------------------------------------------------------------
    ' ウィンドウ分割無しか
    If Not objAW.FreezePanes And Not objAW.Split Then
        ' 表示域外は無視
        If Intersect(objAW.VisibleRange, objTarget) Is Nothing Then Exit Function
    Else            ' 分割あり
        ' ウィンドウ枠固定か
        If objAW.FreezePanes Then
            ' どのウィンドウに属するか判定
            For lngIx = 1 To objAW.Panes.Count
                ' 発見？
                If Not Intersect(objAW.Panes(lngIx).VisibleRange, objTarget) Is Nothing Then
                    lngPaneIx = lngIx
                    Exit For
                End If
            Next lngIx
            ' 見つからないか
            If lngPaneIx = 0 Then Exit Function
        Else
            ' ウィンドウ分割はアクティブペインのみ判定
            If Not Intersect(objAW.ActivePane.VisibleRange, objTarget) Is Nothing Then
                lngPaneIx = objAW.ActivePane.Index
            Else
                Exit Function
            End If
        End If
    End If
    '-----------------------------------------------------------------------------------------------
    ' ※以下はExcel2003以前では動作しない
    lngDPIX = FP_GetDPIX
    lngDPIY = FP_GetDPIY
    lngPPI = FP_GetPPI
    ' ウィンドウ分割無しか
    If lngPaneIx = 0 Then
        lngR1C1Left = objAW.PointsToScreenPixelsX(0)
        lngR1C1Top = objAW.PointsToScreenPixelsY(0)
    Else
        lngR1C1Left = objAW.Panes(lngPaneIx).PointsToScreenPixelsX(0)
        lngR1C1Top = objAW.Panes(lngPaneIx).PointsToScreenPixelsY(0)
    End If
    lngTargetLeft = ((objTarget.Left * (lngDPIX / lngPPI)) * (objAW.Zoom / 100)) + lngR1C1Left
    lngTargetTop = (((objTarget.Top + objTarget.Height) * (lngDPIY / lngPPI)) * (objAW.Zoom / 100)) + lngR1C1Top
    lngFormLeft = lngTargetLeft * (lngPPI / lngDPIX)
    lngFormTop = lngTargetTop * (lngPPI / lngDPIY)
    '-----------------------------------------------------------------------------------------------
    ' スクリーンサイズ位置の取得
    Call GP_GetScreenPos(0, 0, lngScreenRight, lngScreenBottom)
    '-----------------------------------------------------------------------------------------------
    ' ユーザーフォームがスクリーンからはみ出すか(横)
    If (lngFormLeft + lngFormWidth) * (lngDPIX / lngPPI) > lngScreenRight Then
        ' スクリーン右端に移動(+3は誤差？)
        lngFormLeft = lngScreenRight * (lngPPI / lngDPIX) - lngFormWidth + 3
    End If
    ' ユーザーフォームがスクリーンからはみ出すか(縦､タスクバー分は正しく取得できていない)
    If (lngFormTop + lngFormHeight) * (lngDPIY / lngPPI) > lngScreenBottom Then
        ' セル上端に移動
        lngFormTop = lngFormTop - (objRange.Height + lngFormHeight)
    End If
    FP_GetFormPosition = True
End Function

'***************************************************************************************************
'* 処理名　：FP_GetPPI
'* 機能　　：PPI(Pixels Per Inch)取得
'---------------------------------------------------------------------------------------------------
'* 返り値　：PPI値(Long)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetPPI() As Long
    '-----------------------------------------------------------------------------------------------
    FP_GetPPI = Application.InchesToPoints(1)
End Function

'***************************************************************************************************
'* 処理名　：FP_GetDPIX
'* 機能　　：DPI(Dots Per Inch)取得(水平方向)
'---------------------------------------------------------------------------------------------------
'* 返り値　：DPI値(Long)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetDPIX() As Long
    '-----------------------------------------------------------------------------------------------
    FP_GetDPIX = FP_GetDPI(LOGPIXELSX)
End Function

'***************************************************************************************************
'* 処理名　：FP_GetDPIY
'* 機能　　：DPI(Dots Per Inch)取得(垂直方向)
'---------------------------------------------------------------------------------------------------
'* 返り値　：DPI値(Long)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetDPIY() As Long
    '-----------------------------------------------------------------------------------------------
    FP_GetDPIY = FP_GetDPI(LOGPIXELSY)
End Function

'***************************************************************************************************
'* 処理名　：FP_GetDPI
'* 機能　　：DPI(Dots Per Inch)取得(API)
'---------------------------------------------------------------------------------------------------
'* 返り値　：DPI値(Long)
'* 引数　　：Arg1 = nFlag(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2019年10月20日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetDPI(ByVal nFlag As Long) As Long
    '-----------------------------------------------------------------------------------------------
#If VBA7 Then
    Dim lngHdc As LongPtr                                           ' ウィンドウハンドルのDC
#Else
    Dim lngHdc As Long                                              ' ウィンドウハンドルのDC
#End If
    lngHdc = GetDC(Application.hwnd)
    FP_GetDPI = GetDeviceCaps(lngHdc, nFlag)
    Call ReleaseDC(&H0, lngHdc)
End Function

'***************************************************************************************************
'* 処理名　：GP_GetScreenPos
'* 機能　　：スクリーン位置の取得
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = スクリーン左端位置(Long)              ※Ref参照
'* 　　　　　Arg2 = スクリーン上端位置(Long)              ※Ref参照
'* 　　　　　Arg3 = スクリーン右端位置(Long)              ※Ref参照
'* 　　　　　Arg4 = スクリーン下端位置(Long)              ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年12月08日
'* 作成者　：井上　治
'* 更新日　：2019年12月08日
'* 更新者　：井上　治
'* 機能説明：複数スクリーン全体四隅の位置を取得
'* 注意事項：
'***************************************************************************************************
Private Sub GP_GetScreenPos(ByRef lngScreenLeft As Long, _
                            ByRef lngScreenTop As Long, _
                            ByRef lngScreenRight As Long, _
                            ByRef lngScreenBottom As Long)
    '-----------------------------------------------------------------------------------------------
    Dim lngWidth As Long                                            ' スクリーンの幅
    Dim lngHeight As Long                                           ' スクリーンの高さ①
    Dim lngHeight2 As Long                                          ' スクリーンの高さ②
    Dim lngHeight3 As Long                                          ' スクリーンの高さ③
    Dim objRect As g_typRect                                        ' Rect
    ' スクリーンの左端､上端､幅､高さの取得(複数スクリーン対応)
    lngScreenLeft = GetSystemMetrics(SM_XVIRTUALSCREEN)         ' 左端
    lngScreenTop = GetSystemMetrics(SM_YVIRTUALSCREEN)          ' 上端
    lngWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN)             ' 幅(仮想スクリーン域)
    lngHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN)            ' 高さ(仮想スクリーン域)
    lngHeight2 = GetSystemMetrics(SM_CYSCREEN)                  ' 高さ(メインスクリーンのみ)
    ' タスクバーを除くスクリーンの大きさ取得(メインスクリーンのみ)
    Call SystemParametersInfo(SPI_GETWORKAREA, 0, objRect, 0)
    lngHeight3 = objRect.Bottom - objRect.Top                   ' 高さ(メインのタスクバー以外の分)
    ' タスクバーがメインスクリーンの下端にあるものとし、この高さを差し引く
    lngHeight = lngHeight - (lngHeight2 - lngHeight3)
    ' 右端の算出
    lngScreenRight = lngWidth - lngScreenLeft
    ' 下端の算出
    lngScreenBottom = lngHeight - lngScreenTop
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

上で説明している公開プロシージャ上の2つだけですが、セルからカレンダー入力フォームの表示位置を算出する内部プロシージャや、スクリーンからの「はみ出し」の検出・補正する記述が加わったので長くなりました。
これらは利用者が理解する必要がないものですが、Office2007以降限定の関数を使用しているため、Office2003以前では利用できません。

次は、実際のカレンダーのユーザーフォームのコードです。
カレンダーの日付部分は7曜日×6週＝42個と「昨日」「今日」「明日」の計45個の「ラベル」を中心としたものですが、この45個やその他の「ラベル」については以前はユーザーフォームのコード上にズラズラとイベントコードを書いていたのですが、この「UF_Calendar5」から2つのイベントクラス「clsUF_Cal5Label1」「clsUF_Cal5Label2」に分離させたため、このユーザーフォームのコード上からは日付「ラベル」のClickやMouseMoveイベントの記述はなくなりました。（イベントクラスは後述）
2つのイベントクラス「clsUF_Cal5Label1」「clsUF_Cal5Label2」についてはモジュールレベルの変数で宣言しており、「UserForm_Initialize」の最初の方で初期化させています。

最初の方の定数は意味があって、「g_cnsStartYobi」はカレンダーの起算曜日の指定です。デフォルトは「１」となっていますが、これを「２」に替えると左端が月曜日となって表示されるようになります。他の曜日には対応しておらず「２」以外は全て日曜日始まりです。
その下の「g_cnsYearFrom」「g_cnsYearToAdd」がカレンダーの操作で表示させる年範囲の規定です。開始年は祝日法が施行された「1947年」としています。これ以上以前の年に変更すると祝日は正しく表示されません。終了年の方はシステム日付の年に対する「年の増分」で指定するように指定しています。翌々年以降は祝日については正しいとは限りません。


'***************************************************************************************************
'   カレンダーフォーム5(日付入力部品)    ※ユーザーフォーム(改⑤)   UF_Calendar5(UserForm)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   ※祝日法改正時は｢祝日パラメータ｣シートで行なう
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/02/20(4.30)祝日判定関連を｢modAboutCalendar2｣に移行する対応
'18/02/20(4.30)親フォームとの受け渡しをプロパティに変更
'18/02/21(4.31)カレンダー初週の表示不具合修正(1日が表示されない件)、モードレス表示対応
'18/02/21(4.31)結果日付を返さずに本フォーム内でセル(又はTextBox)に日付を書き込むように仕様変更
'18/02/22(4.32)結合セルから値を取り出す時の不具合対応
'18/09/23(1.70)カレンダー関連機能のクラス化対応
'18/11/26(1.71)カレンダーフォーム表示幅調整(Windows10対応)
'18/11/28(1.80)カレンダーフォーム上の各日付ラベルをクラス化(WithEvents)させる対応
'***************************************************************************************************
Option Explicit
'---------------------------------------------------------------------------------------------------
' [起算曜日] ※カレンダーを月曜開始(曜日左端)にする場合は｢2｣に変更して下さい。
Private Const g_cnsStartYobi = 1                            ' 1=日曜日,2=月曜日(他は不可)
'---------------------------------------------------------------------------------------------------
' [年の表示限度(From/To)]
Private Const g_cnsYearFrom = 1947                          ' 祝日法施行
Private Const g_cnsYearToAdd = 3                            ' システム日の年+n年までの指定
'---------------------------------------------------------------------------------------------------
' フォーム上の色指定等の定数
Private Const cnsBC_Select = &HFFCC33                       ' 選択日付の背景色
Private Const cnsBC_Other = &HE0E0E0                        ' 当月以外の背景色
Private Const cnsBC_Sunday = &HFFDDFF                       ' 日曜の背景色
Private Const cnsBC_Saturday = &HDDFFDD                     ' 土曜の背景色
Private Const cnsBC_Month = &HFFFFFF                        ' 当月土日以外の背景色
Private Const cnsFC_Hori = &HFF                             ' 祝日の文字色
Private Const cnsFC_Normal = &HC00000                       ' 祝日以外の文字色
Private Const cnsDefaultGuide = "矢印キーで操作できます。"
Private Const g_cnsDateFormat = "YYYY/MM/DD"                ' デフォルトの日付Format
'---------------------------------------------------------------------------------------------------
' 呼び元との受け渡し変数
Private g_FormDate1 As Date                                 ' 現在日付
Private g_intEntMode As Integer                             ' 入力モード(0=セル、1=TextBox)
Private g_objRange As Range                                 ' 対象セル
Private g_objTextBox As MSForms.TextBox                     ' 対象TextBox
Private g_strDateFormat As String                           ' 日付フォーマット(TextBox時)
'---------------------------------------------------------------------------------------------------
' フォーム表示中に保持するモジュール変数
Private g_tblYobi As Variant                                ' 曜日テーブル
Private g_tblDateLabel(44) As New clsUF_Cal5Label1          ' 日付ラベルイベントクラステーブル
Private g_tblFixLabel(11) As New clsUF_Cal5Label2           ' 固定ラベルイベントクラステーブル
Private g_intCurYear As Integer                             ' 現在表示年
Private g_intCurMonth As Integer                            ' 現在表示月
Private g_CurPos As Long                                    ' 現在日付位置
Private g_CurPosF As Long                                   ' 当月月初日位置
Private g_CurPosT As Long                                   ' 当月月末日位置
Private g_swBatch As Boolean                                ' イベント抑制SW
Private g_VisibleYear As Boolean                            ' Conboの年表示スイッチ
Private g_VisibleMonth As Boolean                           ' Comboの月表示スイッチ

'***************************************************************************************************
' ■フォーム上のイベント
'***************************************************************************************************
'* 処理名　：CBO_MONTH_Change
'* 機能　　：｢月｣コンボの操作イベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub CBO_MONTH_Change()
    '-----------------------------------------------------------------------------------------------
    Dim intMonth As Integer
    If g_swBatch Then Exit Sub
    intMonth = CInt(CBO_MONTH.Text)
    g_FormDate1 = DateSerial(g_intCurYear, intMonth, 1)
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'***************************************************************************************************
'* 処理名　：CBO_YEAR_Change
'* 機能　　：｢年｣コンボの操作イベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub CBO_YEAR_Change()
    '-----------------------------------------------------------------------------------------------
    Dim intYear As Integer
    If g_swBatch Then Exit Sub
    intYear = CInt(CBO_YEAR.Text)
    g_FormDate1 = DateSerial(intYear, g_intCurMonth, 1)
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'***************************************************************************************************
'* 処理名　：LBL_PREV_Click
'* 機能　　：「←(前月)」Clickイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub LBL_PREV_Click()
    '-----------------------------------------------------------------------------------------------
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' 前月月初日を設定
    g_FormDate1 = DateSerial(g_intCurYear, g_intCurMonth - 1, 1)
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'***************************************************************************************************
'* 処理名　：LBL_NEXT_Click
'* 機能　　：「→(翌月)」Clickイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub LBL_NEXT_Click()
    '-----------------------------------------------------------------------------------------------
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' 翌月月初日を設定
    g_FormDate1 = DateSerial(g_intCurYear, g_intCurMonth + 1, 1)
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'***************************************************************************************************
'* 処理名　：LBL_MONTH_Click
'* 機能　　：「月」Clickイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub LBL_MONTH_Click()
    '-----------------------------------------------------------------------------------------------
    Dim intMonth As Integer
    Dim IX As Long, CUR As Long
    ' 年コンボが表示されていたら消去
    Call GP_EraseYear
    ' 月コンボの表示
    g_swBatch = True
    With CBO_MONTH
        .Clear
        For intMonth = 1 To 12
            .AddItem Format(intMonth, "00")
            If intMonth = g_intCurMonth Then CUR = IX
            IX = IX + 1
        Next intMonth
        .ListIndex = CUR
        .Visible = True
        g_VisibleMonth = True
    End With
    g_swBatch = False
End Sub

'***************************************************************************************************
'* 処理名　：LBL_YEAR_Click
'* 機能　　：「年」Clickイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub LBL_YEAR_Click()
    '-----------------------------------------------------------------------------------------------
    Dim intYear As Integer, intYearSTR As Integer, intYearEND As Integer
    Dim IX As Long, CUR As Long
    ' 月コンボが表示されていたら消去
    Call GP_EraseMonth
    ' 年コンボの表示
    g_swBatch = True
    With CBO_YEAR
        .Clear
        intYearSTR = g_intCurYear - 10
        If intYearSTR < g_cnsYearFrom Then intYearSTR = g_cnsYearFrom
        intYearEND = g_intCurYear + 10
        intYear = Year(Date) + g_cnsYearToAdd
        If intYearEND > intYear Then intYearEND = intYear
        For intYear = intYearSTR To intYearEND
            .AddItem CStr(intYear)
            If intYear = g_intCurYear Then CUR = IX
            IX = IX + 1
        Next intYear
        .ListIndex = CUR
        .Visible = True
        g_VisibleYear = True
    End With
    g_swBatch = False
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_Activate
'* 機能　　：フォーム表示(繰り返し表示の場合はHideのみのためInitializeは起きない)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2018年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Activate()
    '-----------------------------------------------------------------------------------------------
    ' コンボは非表示
    CBO_YEAR.Visible = False
    CBO_MONTH.Visible = False
    g_VisibleYear = False
    g_VisibleMonth = False
    g_FormDate1 = 0
    '-----------------------------------------------------------------------------------------------
    ' 入力モード(0=セル、1=TextBox)
    If g_intEntMode = 1 Then
        ' 1=TextBox
        ' 元となる日付をテキストボックスから取得
        If IsDate(Trim(g_objTextBox.Text)) Then
            g_FormDate1 = CDate(Trim(g_objTextBox.Text))
        End If
    Else
        ' 0=セル
        ' 元となる日付をセルから取得
        On Error Resume Next
        If IsDate(Trim(g_objRange.Cells(1).Value)) Then
            g_FormDate1 = CDate(Trim(g_objRange.Cells(1).Value))
        End If
        On Error GoTo 0
    End If
    ' 受け取れない場合は当日をセット
    If g_FormDate1 = 0 Then g_FormDate1 = Date
    '-----------------------------------------------------------------------------------------------
    ' カレンダー作成
    Call GP_MakeCalendar
    LBL_GUIDE.Caption = cnsDefaultGuide             ' ガイド表示
    ' 表示位置をマニュアルに変更
    If Me.StartUpPosition <> 0 Then Me.StartUpPosition = 0
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_Deactivate
'* 機能　　：フォーム非アクティブ状態
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月21日
'* 作成者　：井上　治
'* 更新日　：2018年02月21日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：UserForm上からの利用の対応のためモードレスにできないことからこのイベントは発生しない
'***************************************************************************************************
Private Sub UserForm_Deactivate()
    '-----------------------------------------------------------------------------------------------
    Me.Hide
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_Initialize
'* 機能　　：フォーム初期化(繰り返し表示の場合はHideのみのためInitializeは起きない)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim lngIx2 As Long                                              ' テーブルINDEX
    Dim lngIxC As Long                                              ' カレンダーテーブルINDEX
    Dim dteDate As Date                                             ' 日付WORK
    Dim tblTodayNm As Variant                                       ' 昨日､今日､明日の名称
    Dim tblCalendar() As g_typAboutCalendar2                        ' カレンダーテーブル
    '-----------------------------------------------------------------------------------------------
    ' 各日付ラベルイベントクラスの初期化
    For lngIx = 0 To 44
        Call g_tblDateLabel(lngIx).NewClass(Me.Controls("LBL_" & Format((lngIx + 1), "00")), lngIx)
    Next lngIx
    ' 各固定ラベルイベントクラスの初期化
    Call g_tblFixLabel(0).NewClass(LBL_SUN, cnsDefaultGuide)        ' 日
    Call g_tblFixLabel(1).NewClass(LBL_MON, cnsDefaultGuide)        ' 月
    Call g_tblFixLabel(2).NewClass(LBL_TUE, cnsDefaultGuide)        ' 火
    Call g_tblFixLabel(3).NewClass(LBL_WED, cnsDefaultGuide)        ' 水
    Call g_tblFixLabel(4).NewClass(LBL_THU, cnsDefaultGuide)        ' 木
    Call g_tblFixLabel(5).NewClass(LBL_FRI, cnsDefaultGuide)        ' 金
    Call g_tblFixLabel(6).NewClass(LBL_SAT, cnsDefaultGuide)        ' 土
    Call g_tblFixLabel(7).NewClass(LBL_PREV, "前月に戻ります(PageUp)") ' ←
    Call g_tblFixLabel(8).NewClass(LBL_NEXT, "翌月に進みます(PageDown)") ' →
    Call g_tblFixLabel(9).NewClass(LBL_YM, "年か月を選択します。")  ' 年月
    Call g_tblFixLabel(10).NewClass(LBL_YEAR, "年が選択できます。") ' 年
    Call g_tblFixLabel(11).NewClass(LBL_MONTH, "月が選択できます。") ' 月
    '-----------------------------------------------------------------------------------------------
    ' 起算曜日による曜日見出しの位置修正
    If g_cnsStartYobi = 2 Then
        ' 月曜起算
        LBL_MON.Left = 3
        LBL_MON.Width = 16.75
        LBL_TUE.Left = 20.5
        LBL_WED.Left = 38
        LBL_WED.Width = 17
        LBL_THU.Left = 55.5
        LBL_THU.Width = 16.75
        LBL_FRI.Left = 73
        LBL_SAT.Left = 90.5
        LBL_SUN.Left = 108
        LBL_SUN.Width = 17
    Else
        ' 日曜起算
        LBL_SUN.Left = 3
        LBL_SUN.Width = 16.75
        LBL_MON.Left = 20.5
        LBL_TUE.Left = 38
        LBL_TUE.Width = 17
        LBL_WED.Left = 55.5
        LBL_WED.Width = 16.75
        LBL_THU.Left = 73
        LBL_FRI.Left = 90.5
        LBL_SAT.Left = 108
        LBL_SAT.Width = 17
    End If
    g_tblYobi = Array("(日)", "(月)", "(火)", "(水)", "(木)", "(金)", "(土)")
    '-----------------------------------------------------------------------------------------------
    ' 昨日､今日､明日の処理
    dteDate = Date              ' 今日
    ' カレンダーテーブル作成(当月+前後の3ヶ月用)
    If Not modAboutCalendar2.FP_GetCalendarTable3(Year(dteDate), _
                                                  Month(dteDate), _
                                                  tblCalendar) Then Exit Sub
    ' 昨日に戻す
    dteDate = dteDate - 1
    lngIxC = 0
    ' カレンダー上の昨日の位置を判定
    Do While lngIxC <= UBound(tblCalendar)
        ' 日付発見は抜ける
        If tblCalendar(lngIxC).Hiduke = dteDate Then Exit Do
        ' 次の日へ
        lngIxC = lngIxC + 1
    Loop
    tblTodayNm = Array("[昨日]", "[今日]", "[明日]")
    lngIx2 = 0
    ' 昨日､今日､明日のセット
    For lngIx = 42 To 44
        dteDate = tblCalendar(lngIxC).Hiduke
        ' 日付コントロール情報テーブルのセット
        With g_tblDateLabel(lngIx)
            .Hiduke = dteDate
            .Yobi = tblCalendar(lngIxC).Yobi
            .Syuku = tblCalendar(lngIxC).Syuku
            .StsGuide = tblTodayNm(lngIx2) & Format(dteDate, g_cnsDateFormat) & g_tblYobi(.Yobi)
            ' 祝日か
            If .Syuku <> 0 Then
                .StsGuide = .StsGuide & " " & tblCalendar(lngIxC).SyukuNm
            End If
        End With
        ' カレンダーテーブル位置を翌日に移動
        lngIxC = lngIxC + 1
        lngIx2 = lngIx2 + 1
    Next lngIx
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_KeyDown
'* 機能　　：フォーム上キーボード処理
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                             ByVal Shift As Integer)
    '-----------------------------------------------------------------------------------------------
    ' KeyCode(Shift併用)による制御
    Select Case KeyCode
        Case vbKeyReturn, vbKeyExecute, vbKeySeparator  ' Enter(決定)
            Call GP_ClickCalendar(g_CurPos)
        Case vbKeyCancel, vbKeyEscape                   ' Cancel, Esc(終了)
            Me.Hide
        Case vbKeyPageDown                              ' PageDown(次月)
            Call LBL_NEXT_Click
        Case vbKeyPageUp                                ' KeyPageUp(前月)
            Call LBL_PREV_Click
        Case vbKeyRight, vbKeyNumpad6, vbKeyAdd         ' →(翌日)
            Call GP_MoveDay(1)
        Case vbKeyLeft, vbKeyNumpad4, vbKeySubtract     ' ←(前日)
            Call GP_MoveDay(-1)
        Case vbKeyUp, vbKeyNumpad8                      ' ↑(7日後)
            Call GP_MoveDay(-7)
        Case vbKeyDown, vbKeyNumpad2                    ' ↓(7日前)
            Call GP_MoveDay(7)
        Case vbKeyHome                                  ' Home(月初)
            Call GP_MoveDay(g_CurPosF - g_CurPos)
        Case vbKeyEnd                                   ' End(月末)
            Call GP_MoveDay(g_CurPosT - g_CurPos)
        Case vbKeyTab                                   ' Tab(Shiftによる)
            If Shift = 1 Then
                Call GP_MoveDay(-1)                     ' 前日
            Else
                Call GP_MoveDay(1)                      ' 翌日
            End If
        Case vbKeyF11                                   ' F11(前年)
            g_FormDate1 = DateSerial(g_intCurYear - 1, g_intCurMonth, 1)
            ' 年月コンボの非表示化
            Call GP_EraseYearMonth
            ' カレンダー作成
            Call GP_MakeCalendar
        Case vbKeyF12                                   ' F11(翌年)
            g_FormDate1 = DateSerial(g_intCurYear + 1, g_intCurMonth, 1)
            ' 年月コンボの非表示化
            Call GP_EraseYearMonth
            ' カレンダー作成
            Call GP_MakeCalendar
    End Select
End Sub

'***************************************************************************************************
'* 処理名　：UserForm_MouseMove
'* 機能　　：フォーム上マウス移動
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_MouseMove(ByVal Button As Integer, _
                               ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    '-----------------------------------------------------------------------------------------------
    Me.LBL_GUIDE.Caption = cnsDefaultGuide
End Sub

'***************************************************************************************************
' ■共通サブ処理(Private)
'***************************************************************************************************
'* 処理名　：GP_MakeCalendar
'* 機能　　：カレンダー表示
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_MakeCalendar()
    '-----------------------------------------------------------------------------------------------
    Dim dteDate As Date                                             ' 日付WORK
    Dim intYobi As Integer                                          ' 曜日位置INDEX
    Dim intYear As Integer                                          ' 指定年
    Dim lngCurStrIx As Long                                         ' 当月開始INDEX
    Dim lngCurEndIx As Long                                         ' 当月終了INDEX
    Dim lngIx As Long                                               ' フォーム上位置INDEX
    Dim lngIx2 As Long                                              ' テーブルINDEX(Work)
    Dim lngIxC As Long                                              ' カレンダーINDEX
    Dim lngIxCMax As Long                                           ' カレンダーINDEX上限
    Dim lngCurPos As Long                                           ' 選択日の位置
    Dim tblCalendar() As g_typAboutCalendar2                        ' カレンダーテーブル
    '-----------------------------------------------------------------------------------------------
    intYear = Year(g_FormDate1)                                 ' 指定年
    ' 指定年月が利用可能かチェック
    If ((intYear < g_cnsYearFrom) Or _
        (intYear > (Year(Date) + g_cnsYearToAdd))) Then
        MsgBox "祝日計算範囲を超えています。", vbExclamation, Me.Caption
        g_FormDate1 = g_tblDateLabel(g_CurPos).Hiduke
    End If
    g_intCurYear = Year(g_FormDate1)                            ' 指定年
    g_intCurMonth = Month(g_FormDate1)                          ' 指定月
    LBL_YM.Caption = g_intCurYear & "年" & Format(g_intCurMonth, "00") & "月"
    '-----------------------------------------------------------------------------------------------
    ' カレンダーテーブル作成(当月+前後の3ヶ月用)
    Call modAboutCalendar2.GP_GetCalendarTable3(g_intCurYear, _
                                                g_intCurMonth, _
                                                tblCalendar, _
                                                lngCurStrIx, _
                                                lngCurEndIx)
    lngIxCMax = UBound(tblCalendar)
    ' カレンダーテーブル先頭位置
    lngIxC = lngCurStrIx
    ' 指定日付から一旦、前週の最終日(日曜日)に戻す
    lngIxC = lngIxC - tblCalendar(lngCurStrIx).Yobi
    ' 月曜始まり時の調整
    If g_cnsStartYobi = 2 Then
        lngIxC = lngIxC + 1
        ' 2日始まりになってしまう時は1週戻す
        If lngIxC > lngCurStrIx Then lngIxC = lngIxC - 7
    End If
    intYobi = 0
    lngCurPos = -1
    '-----------------------------------------------------------------------------------------------
    ' フォーム上の日付セット(7曜×6週=42件固定⇒0始まり)
    For lngIx = 0 To 41
        ' 当位置の日付、曜日を算出
        intYobi = intYobi + 1
        If intYobi > 7 Then intYobi = 1
        dteDate = tblCalendar(lngIxC).Hiduke
        ' 現在選択日か
        If dteDate = g_FormDate1 Then
            lngCurPos = lngIx
        End If
        ' 日付コントロール情報テーブルのセット
        With g_tblDateLabel(lngIx)
            .Hiduke = dteDate
            .Yobi = tblCalendar(lngIxC).Yobi
            .Syuku = tblCalendar(lngIxC).Syuku
            .StsGuide = Format(dteDate, g_cnsDateFormat) & g_tblYobi(.Yobi)
            ' 祝日か
            If .Syuku <> 0 Then
                .StsGuide = .StsGuide & " " & tblCalendar(lngIxC).SyukuNm
            End If
        End With
        ' 月初日、月末日の位置を取得
        If lngIxC = lngCurStrIx Then
            ' 当月初日
            g_CurPosF = lngIx
        ElseIf lngIxC = lngCurEndIx Then
            ' 当月末日
            g_CurPosT = lngIx
        End If
        ' ラベルコントロールを配列化した変数
        g_tblDateLabel(lngIx).Label.Caption = Day(dteDate)
        ' 文字色、背景色のセット
        Call GP_SetForeColor(lngIx, g_FormDate1)
        ' カレンダーテーブル位置を翌日に移動
        lngIxC = lngIxC + 1
    Next lngIx
    LBL_GUIDE.Caption = g_tblDateLabel(g_CurPos).StsGuide   ' ガイド表示
End Sub

'***************************************************************************************************
'* 処理名　：GP_MoveDay
'* 機能　　：カレンダー上の選択位置移動
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 移動量(Long)                ※マイナスあり
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_MoveDay(lngMove As Long)
    '-----------------------------------------------------------------------------------------------
    Dim lngPos As Long                                              ' テーブル位置INDEX
    Dim dteDate As Date                                             ' 日付Work
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' 移動後の位置,日付を算出
    lngPos = g_CurPos + lngMove                                 ' 移動後位置
    dteDate = g_FormDate1 + lngMove                             ' 移動後日付
    ' コントロールテーブル外か
    If ((lngPos < 0) Or (lngPos > 41)) Then
        ' 前月又は翌月に移動
        g_FormDate1 = dteDate
        Call GP_MakeCalendar
        Exit Sub
    End If
    '-----------------------------------------------------------------------------------------------
    ' 以前の位置の日付ラベルの背景色を元に戻す
    Call GP_SetForeColor(g_CurPos, dteDate)
    '-----------------------------------------------------------------------------------------------
    ' 現在日付(退避)を更新
    g_FormDate1 = dteDate
    g_CurPos = lngPos
    ' 今回の位置の日付ラベルの背景色を選択状態に変更
    Call GP_SetForeColor(g_CurPos, g_FormDate1)
    LBL_GUIDE.Caption = g_tblDateLabel(g_CurPos).StsGuide   ' ガイド表示
End Sub

'***************************************************************************************************
'* 処理名　：GP_SetForeColor
'* 機能　　：文字色、背景色のセット
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 現在日付位置INDEX(Long)
'* 　　　　　Arg2 = 選択日付(Date)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月20日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：位置INDEXはラベルコントロール配列上の位置
'***************************************************************************************************
Private Sub GP_SetForeColor(ByVal lngPos As Long, ByVal dteCurDate As Date)
    '-----------------------------------------------------------------------------------------------
    Dim dteDate As Date                                             ' 日付Work
    Dim lngYear As Long                                             ' 現在年
    Dim lngMonth As Long                                            ' 現在月
    With g_tblDateLabel(lngPos)
        dteDate = .Hiduke
        lngYear = Year(dteDate)
        lngMonth = Month(dteDate)
        ' 月度、曜日によりラベルの書式をセット
        .Label.Font.Bold = False
        .Label.ForeColor = cnsFC_Normal
        ' 現在選択日か
        If dteDate = dteCurDate Then
            ' 初期選択日付
            .Label.BackColor = cnsBC_Select
            g_CurPos = lngPos
        ElseIf ((lngYear = g_intCurYear) And (lngMonth = g_intCurMonth)) Then   ' 当月内か
            ' 当月
            Select Case .Yobi
                Case 0                  ' 日曜日
                    .Label.BackColor = cnsBC_Sunday
                Case 6                  ' 土曜日
                    .Label.BackColor = cnsBC_Saturday
                Case Else
                    .Label.BackColor = cnsBC_Month
            End Select
        Else
            ' 当月以外
            .Label.BackColor = cnsBC_Other
        End If
        ' 祝日(含振替休日)の判定
        If .Syuku <> 0 Then
            ' 文字色を赤とする
            .Label.ForeColor = cnsFC_Hori
            ' 当月は太字
            If ((lngYear = g_intCurYear) And (lngMonth = g_intCurMonth)) Then .Label.Font.Bold = True
        End If
    End With
End Sub

'***************************************************************************************************
'* 処理名　：GP_ShowGuide
'* 機能　　：ステータスガイド表示
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 現在日付位置INDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年02月20日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：位置INDEXはラベルコントロール配列上の位置
'***************************************************************************************************
Friend Sub GP_ShowGuide(ByVal lngPos As Long)
    '-----------------------------------------------------------------------------------------------
    LBL_GUIDE.Caption = g_tblDateLabel(lngPos).StsGuide
End Sub

'***************************************************************************************************
'* 処理名　：GP_ClickCalendar
'* 機能　　：カレンダークリック
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 日付コントロール情報テーブルINDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Friend Sub GP_ClickCalendar(ByVal lngPos As Long)
    '-----------------------------------------------------------------------------------------------
    g_FormDate1 = g_tblDateLabel(lngPos).Hiduke
    ' 年月コンボの非表示化
    Call GP_EraseYearMonth
    ' 入力モード(0=セル、1=TextBox)
    If g_intEntMode = 1 Then
        ' 1=TextBox
        g_objTextBox.Text = Format(g_FormDate1, g_strDateFormat)
    Else
        ' 0=セル
        g_objRange.Value = g_FormDate1
    End If
    Me.Hide
End Sub

'***************************************************************************************************
'* 処理名　：GP_EraseYearMonth
'* 機能　　：｢年｣｢月｣コンボの非表示化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_EraseYearMonth()
    '-----------------------------------------------------------------------------------------------
    Call GP_EraseYear
    Call GP_EraseMonth
End Sub

'***************************************************************************************************
'* 処理名　：GP_EraseYear
'* 機能　　：｢年｣コンボの非表示化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_EraseYear()
    '-----------------------------------------------------------------------------------------------
    If g_VisibleYear Then
        CBO_YEAR.Visible = False
        g_VisibleYear = False
    End If
End Sub

'***************************************************************************************************
'* 処理名　：GP_EraseMonth
'* 機能　　：｢月｣コンボの非表示化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2010年01月13日
'* 作成者　：井上　治
'* 更新日　：2010年01月13日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_EraseMonth()
    '-----------------------------------------------------------------------------------------------
    If g_VisibleMonth Then
        CBO_MONTH.Visible = False
        g_VisibleMonth = False
    End If
End Sub

'***************************************************************************************************
' ■■■ プロパティ ■■■
'***************************************************************************************************
' タイトル
'---------------------------------------------------------------------------------------------------
Friend Property Let prpTitle(ByVal strTitle As String)
    Me.Caption = strTitle
End Property

'===================================================================================================
' 入力モード(1=セル、2=TextBox)
'---------------------------------------------------------------------------------------------------
Friend Property Let prpEntMode(ByVal intValue As Integer)
    g_intEntMode = intValue
End Property

'===================================================================================================
' 対象セル(Object)
'---------------------------------------------------------------------------------------------------
Friend Property Set prpRange(ByRef objValue As Range)
    Set g_objRange = objValue
End Property

'===================================================================================================
' 対象TextBox(Object)
'---------------------------------------------------------------------------------------------------
Friend Property Set prpTextBox(ByRef objValue As MSForms.TextBox)
    Set g_objTextBox = objValue
End Property

'===================================================================================================
' 日付フォーマット(TextBox時)
'---------------------------------------------------------------------------------------------------
Friend Property Let prpDateFormat(ByVal strFormat As String)
    g_strDateFormat = strFormat
End Property

'------------------------------------------<< End of Source >>--------------------------------------

キーボード操作のイベントは「UserForm_KeyDown」でまとめて受け取っているのが分かると思います。このような処理方法を実現するには、「ラベル」などフォーカスを受けないコントロールだけで構成する必要があります。テキストボックスやコマンドボタンなどを配置してしまうと、自動タブでそのテキストボックスやコマンドボタンにフォーカスが移ってしまい、ユーザーフォームレベルではキー操作のイベントが受け取れません。今回のカレンダーは、年月をクリックした時だけコンボボックスが表示されますが、通常は非表示であって、それ以外は全て「ラベル」です。ユーザーフォーム上のどのコントロールもフォーカスを受け取らない状態であれば、キー操作のイベントがフォーム自身のイベントで受け取ることができます。

矢印キーでの「表示カーソル」の移動についての処理が結構簡素なのが分かると思います。フォーム上は7曜日×6週＝42個の「二次元表記」なのですが、内部処理では「昨日」「今日」「明日」を含めた単なる45個の配列で処理しています。現在の位置INDEXを押さえておいて、「→」なら「+1」、「←」なら「-1」、「↑」なら「-7」、「↓」なら「+7」の位置に移動させるだけです。移動先が「0」～「41」の42個の範囲を超える場合は前後の月を表示し直すようにサブ処理側でコントロールさせています。

「年」「月」のコンボボックスの表示の区別は、もともと上段の年月表示のラベルはひとつしかないのですが、この「年」「月」の表示位置の上に「透明なラベル（LBL_YEAR,LBL_MONTH）」を配して起動させています。コンボボックス自体は、その上で年月の選択が行なわれたり、他のラベルがクリックされた場合は直ちに消去させてキーボードイベントがフォームで受け取れるようにさせています。

次は、ユーザーフォーム上に配置されたラベルのイベントクラスのコードです。
まずは日付部分の7曜日×6週＝42個と「昨日」「今日」「明日」の計45個の「ラベル」で動作するクラスです。


'***************************************************************************************************
'   カレンダーフォーム5用日付ラベル                                 clsUF_Cal5Label1(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/11/28(1.80)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Public WithEvents Label As MSForms.Label                        ' 日付ラベル
Private g_lngIndex As Long                                      ' 位置INDEX(0～44)
Private g_dteHiduke As Date                                     ' 日付
Private g_lngYobi As Long                                       ' 曜日
Private g_lngSyuku As Long                                      ' 祝日フラグ
Private g_strGuide As String                                    ' ステータスガイド

'***************************************************************************************************
'   ■■■ 初期化 ■■■
'***************************************************************************************************
'* 処理名　：NewClass
'* 機能　　：クラス初期化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = ラベル(Object)
'* 　　　　　Arg2 = 位置INDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年11月28日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub NewClass(ByVal objLabel As MSForms.Label, ByVal lngIx As Long)
    '-----------------------------------------------------------------------------------------------
    Set Label = objLabel
    g_lngIndex = lngIx
End Sub

'***************************************************************************************************
'* 処理名　：Label_Click
'* 機能　　：ラベルのクリックイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年11月28日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Label_Click()
    '-----------------------------------------------------------------------------------------------
    Call UF_Calendar5.GP_ClickCalendar(g_lngIndex)
End Sub

'***************************************************************************************************
'* 処理名　：Label_MouseMove
'* 機能　　：ラベルのMouseMoveイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年11月28日
'* 作成者　：井上　治
'* 更新日　：2018年11月28日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Label_MouseMove(ByVal Button As Integer, _
                            ByVal Shift As Integer, _
                            ByVal X As Single, _
                            ByVal Y As Single)
    '-----------------------------------------------------------------------------------------------
    Call UF_Calendar5.GP_ShowGuide(g_lngIndex)
End Sub

'***************************************************************************************************
'   ■■■ プロパティ ■■■
'***************************************************************************************************
' 日付(Date)
'---------------------------------------------------------------------------------------------------
Public Property Let Hiduke(ByVal dteDate As Date)
    g_dteHiduke = dteDate
End Property
Public Property Get Hiduke() As Date
    Hiduke = g_dteHiduke
End Property

'===================================================================================================
' 曜日(Long)
'---------------------------------------------------------------------------------------------------
Public Property Let Yobi(ByVal lngYobi As Long)
    g_lngYobi = lngYobi
End Property
Public Property Get Yobi() As Long
    Yobi = g_lngYobi
End Property

'===================================================================================================
' 祝日フラグ(Long)
'---------------------------------------------------------------------------------------------------
Public Property Let Syuku(ByVal lngSyuku As Long)
    g_lngSyuku = lngSyuku
End Property
Public Property Get Syuku() As Long
    Syuku = g_lngSyuku
End Property

'===================================================================================================
' ステータスガイド(String)
'---------------------------------------------------------------------------------------------------
Public Property Let StsGuide(ByVal strGuide As String)
    g_strGuide = strGuide
End Property
Public Property Get StsGuide() As String
    StsGuide = g_strGuide
End Property

'------------------------------------------<< End of Source >>--------------------------------------

大したコードではありませんが、このクラスがユーザーフォームの初期化時に45個生成されます。
それぞれがClickとMouseMoveのイベントを持ち、日付、曜日、祝日、ステータスガイド文字列のプロパティを持っています。 Clickイベントでは選択されたラベルのインデックス情報をカレンダーのユーザーフォームに通知して選択日付を決定する動作を行ない、 MouseMoveイベントではマウスが載った位置の日付情報をカレンダーのユーザーフォームのステータスバーに表示させる役目をします。
フォントや背景色の変更があるため、クラスにセットされるラベルはPublicスコープに設定させています。

次は、日付以外のラベルのイベントクラスのコードです。
「←」「→」「年」「月」の他、各曜日の見出し等の計12個のラベルのクラスが生成されます。


'***************************************************************************************************
'   カレンダーフォーム5用固定ラベル(MouseMoveイベントのみ)          clsUF_Cal5Label2(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'18/11/30(1.80)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Public WithEvents Label As MSForms.Label                        ' 日付ラベル
Private g_strGuide As String                                    ' ステータスガイド

'***************************************************************************************************
'   ■■■ 初期化 ■■■
'***************************************************************************************************
'* 処理名　：NewClass
'* 機能　　：クラス初期化
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = ラベル(Object)
'* 　　　　　Arg2 = ステータスガイド(String)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年11月30日
'* 作成者　：井上　治
'* 更新日　：2018年11月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub NewClass(ByVal objLabel As MSForms.Label, ByVal strGuide As String)
    '-----------------------------------------------------------------------------------------------
    Set Label = objLabel
    g_strGuide = strGuide
End Sub

'***************************************************************************************************
'* 処理名　：Label_MouseMove
'* 機能　　：ラベルのMouseMoveイベント
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2018年11月30日
'* 作成者　：井上　治
'* 更新日　：2018年11月30日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub Label_MouseMove(ByVal Button As Integer, _
                            ByVal Shift As Integer, _
                            ByVal X As Single, _
                            ByVal Y As Single)
    '-----------------------------------------------------------------------------------------------
    UF_Calendar5.LBL_GUIDE.Caption = g_strGuide
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

このクラスが担当するのはMouseMoveイベントでのユーザーフォームのステータスバーに表示させる機能のみです。表示させる文字列もユーザーフォームの初期化時点で決定されてしまい、以降変更はされません。
Clickイベントの動作は各ラベルで全く異なるため、このクラス内には実装させずにユーザーフォーム側で実装させています。

このような機能は特に「配布の問題」にご注意下さい。

「便利な機能だから社内の皆さんに利用していただけるようにしよう」という発想はすばらしいのですが、 Excelワークブックの場合は社内あちこちに配布してしまうと「機能変更」が発生した場合の更新が大変なことになります。
これらの機能を盛り込んだExcelワークブックを社内各署に配布してしまうと、各現場でその「コピー」も作成されるわけで、どこまで「機能変更」の対応ができたか、どれだけ残っているのかなどがおそらく「不明」になってしまうということに着目した上で配布方法を検討して下さい。

このページで紹介している機能には祝日判定の機能が含まれており、旧来のソースコードで祝日判定する方法でも、「祝日パラメータ」シートで判定する方法であっても、後から祝日法が変わった場合に変更が必要になります。配布先にこの変更をどのようにして反映させるのかを最初から検討した上で更新可能な方法を確立して配布するようにして下さい。
また、配布先のどのExcelワークブックがどの改変バージョンになっているのかが判定できるようにすることも必要です。

お勧めなのは、各現場で今回のカレンダー関連ワークブック「コピー」を作らせない方法です。
今回のような「カレンダー周り」の機能は社内全域から参照可能な共有フォルダにアドインとして配置して、各現場に配布するワークブックのマクロからアドイン参照するように仕掛けられれば、中央の社内全域から参照可能な共有フォルダにあるカレンダーアドインだけをメンテすれば、各現場に配布したワークブックからも開いた時に最新のカレンダーアドインを参照するような構造にすることができると思います。

また、ここで具体例は紹介できませんが「祝日パラメータ」をワークシートとせずに全社から参照可能なデータベーステーブルに保持させて、そこから参照するという方法も考えられます。もちろん、そのデータベーステーブルを参照できるネットワーク環境下での利用に限られますが。

次頁に後から用意した「アドイン版」であれば、アドイン側でカレンダー機能の主要部と祝日パラメータを一元管理させています。このアドインはネットワーク環境下で統一された場所にも配置できるので、バージョン改変への対応方法のひとつとしても考えられると思います。

←Calendar5.zip
(139KB)

「祝日パラメータシート」は使いたくない！

シート構成が変更できないなど「祝日パラメータシート」は使いたくないというご意見もいただきました。内容は「年間カレンダー作成(祝日パラメータシートを使わない方法)」で説明していますが、本機能に反映させたものも用意しました。

←Calendar5R.zip
(151KB)