【 ktMultiCal 】

期間日付を入力するカレンダーフォームをポップアップする関数です。
『VBA Only』    [ デモアニメ ]

【 構 文 】

ktMultiCal(

日付1, 日付2, [基準日], [月数], [休日Map], [Pos_X], [Pos_Y], [入力Msg], [営休制限], [期間制限Fr], [期間制限To] )

返却値	‥‥‥	Boolean型
日  付1	‥‥‥	Date 型 (ByRef)
日  付2	‥‥‥	Date 型 (ByRef)
基準日	‥‥‥	Variant(Date 又は 日付文字列)型    (省略可)
月数	‥‥‥	Variant(Integer) 型    (省略可)
休日Map	‥‥‥	String 型 (省略可)
Pos_X	‥‥‥	Variant(Integer / Empty)型 (省略可)
Pos_Y	‥‥‥	Variant(Integer / Empty)型 (省略可)
入力Msg	‥‥‥	String 型 (省略可)
営休制限	‥‥‥	Variant(Integer) 型 (省略可)
期間制限Fr	‥‥‥	Variant(Date 又は 日付文字列)型 (省略可)
期間制限To	‥‥‥	Variant(Date 又は 日付文字列)型 (省略可)

【 返 却 値 】

日付が選択された場合は返却値として"True"が返ります。
入力キャンセルした場合は"False"が返ります。

【 パラメータ 内容 】

日付1/2	‥‥‥	この項目に選択した日付が設定されて呼び元に返されます。 日付1が[開始日]､日付2が[終了日]です。 呼び元での変数定義が必要です。
基準日	‥‥‥	この日付の『年月』でカレンダーが初期表示されます。 ※ 新元号「令和」対応になっていない環境でも     「令和 日付文字列(元年 表記を含む)」を指定可能です。 通常は、選択した「日付」を設定する項目/オブジェクト(Value値)を指定します。（こうすると､再度フォームを表示させた時に､前回選択した日付の『年月』で表示させる事ができます）。 指定した項目/オブジェクトの内容が『Emptyや日付以外』の場合は既定値として本日日付が適用されます。 省略時には､既定値として本日日付が適用されます。
月  数	‥‥‥	カレンダーフォームには「２つの月」が表示されます。その２つの月の隔たりの初期値を､１以上の数値で指定します。既定は「１」で翌月です。
休日Map	‥‥‥	『休日Map』または『固定休日コード』を指定します。 ここに指定した休日はピンクで表示されます。 省略時は､「休日なし」としてピンク表示されません。
Pos_X   および Pos_Y	‥‥‥	カレンダーフォームを画面のどの位置に表示するかを指定するパラメータです。 UserForm のプロパティ（Left / Top )で指定する値です。 一方もしくは両方を省略すると『オーナーフォーム中央』に表示します。 または、一方 もしくは 両方に Empty 値 を指定した場合も、省略 と 同じ扱いで『 オーナーフォーム中央 』 に表示します。 「あるセルの付近に表示する」 という場合には、ktCell2Position 関数 を 使って、セルの座標を変換した値を指定してください （使用例を参照）。 参考 ： 表示位置によるPos_X および Pos_Y の値（1024×768サイズの画面）     画面全体の左上 ‥‥‥ Pos_X=0 , Pos_Y=0              〃　　中央 ‥‥‥ Pos_X=300 , Pos_Y=170              〃　　右下 ‥‥‥ Pos_X=580 , Pos_Y=350
入力Msg	‥‥‥	ここに指定した文字列がキャプション部分に表示されます。 全角20文字/半角28文字程度まで指定できます。 省略時はフォーム名である[ktMultiCal]が表示されます。
営休制限	‥‥‥	営業日のみ/休業日のみ等の入力制限を施す場合に指定します。     ０ または 省略：[営/休]制限なし。     １ ：[営業日のみ]入力可     ２ ：[休業日のみ]入力可     ３ ：『休日Map』の期間内のみ入力可     ４ ：『休日Map』の期間内で営業日のみ入力可     ５ ：『休日Map』の期間内で休業日のみ入力可 （３〜５では期間制限Fr/Toの指定は不要です）
期間制限Fr   および 期間制限To	‥‥‥	日付入力できる期間を[Fr/To]で指定します。 ※ 新元号「令和」対応になっていない環境でも     「令和 日付文字列(元年 表記を含む)」を指定可能です。 『月初〜月末』だけでなく『１６日〜１５日』といった期間も指定できます。 日付文字列/Date型変数/日付データのセル等で指定します。 [月末まで]という場合は『正しい月末日』を指定して下さい。 「2/30や11/31」といった指定は無効とされます。 [営休制限=３〜５]の場合     Fr/Toを指定しなくても休日Mapの有効期間が摘要されます。     Fr/Toも一緒に指定した場合は､両方の重なる期間が用いられます。     全く重なる期間が無い場合は休日Mapの有効期間が摘要されます。

【 解 説 】

  このktMultiCal 関数は期間（開始日〜終了日の２日付）を一度に入力する為のツールです。
普通は２つのテキストボックスを用意して､各々に日付を入力して貰い､
    ・[Exit ]イベントで個々の日付妥当チェック
    ・実行開始のコマンドボタン等の[Click ]イベント時に､
      開始/終了ともに入力済か？　開始日≦終了日になっているか？
といったチェックを行い「エラーならば再入力」といった処理が必要になります。

このktMultiCal 関数を使えば､その結果として得られる内容は
    ・[開始日≦終了日]条件を満たす[２つの日付がセット]で返る
    ・[日付シリアル値]そのもの
が保証されていますので､今までのようなチェック処理は一切不要になります。
　
  ただし､テキストボックスなど「手入力可」状態のコントロールに受け取ったのでは､ktMultiCal 関数の
後に「手入力で直される」可能性があり､チェック処理を残さざるを得ませんから､下記の例（体験ブック）
のように､コマンドボタンでktMultiCal 関数を呼び出し､ラベルに結果を表示するようにした方が効果的
です（この場合､内容クリア用のボタンも必要になります）。


  更に､ktCalDate関数と同様に選択する日付に対して「営業日/休業日」の制限や「選択可能な期間」
の制限を指定できますので､この機能を利用すれば､よりコンパクトな処理で済みます。

【 フォーム操作方法 】

  フォームには､２つの月が並んでおり､各々に[月]表示切替用の年/月スピンボタンが､また､２つの月
の間隔を指定する[月数]用のスピンボタンが設けてあります。これらは全て連動しており､左側カレンダー
を変えると､右側カレンダーも一緒に年月が変わります。右側カレンダーの年月を変えても左側は動きま
せんが､代わりに[月数]の内容が連動して上下します。[月数]を変更する場合も右側カレンダーだけが
変わります。

  初期表示は､左側カレンダーが引数[基準日]の年月で､右側カレンダーは､左側の年月に引数[月数]を
加えた年月になります。

  営休制限/期間制限を指定した場合は､フォーム上に『日付指定制限条項』という表示が出ます。この
部分にマウスを重ねると､その条件が表示されます。

  カレンダー上でマウスを動かすと､それに合わせて日付部分が水色背景でアクティブ表示されます。
営休制限/期間制限を指定している場合､入力不可の日付に対してはアクティブ表示されません。

  期間の指定は『２クリック』で行ないます。先ず､１回目のクリックで開始日を指定します。その後はマウ
スの動きに合わせて期間範囲がアクティブ表示されます。２回目のクリックで終了日を指定すると【ＯＫボ
タン】が入力可になりますので､ＯＫをクリックして完了します。終了日は開始日より前の部分ではクリック
できないようになっています。

  ＯＫをクリックしないで､もう一度カレンダー部分をクリックすると､終了日の指定が解除されて再び期間
指定が可能になります。開始日を解除する場合は【Clear 】をクリックしてください。また､カレンダーの
年月を切り替えた場合も開始日が解除されます。

【 使 用 例 】

Dim dtm開始日 As Date
Dim dtm終了日 As Date
Dim str休日Map As String  ‥‥‥  「休日マップ」が設定されている変数

※[kt_土日祝]などは「kt関数Addin.xla」内で定義されている『固定休日』定数です。

--- 基本形 ---
If ktMultiCal(dtm開始日, dtm終了日, Date, 1, kt_土日祝) Then
    aaaa = Format(dtm開始日, "yyyy/m/d")
    bbbb = Format(dtm終了日, "yyyy/m/d")
End If


--- パラメータの指定パターン例 --------------------------

(1) 省略できるパラメータを全て省略

    ktMultiCal(dtm開始日, dtm終了日)

    本日日付の「年月」＆『休日表示なし』で表示されます。
    これは､下記の指定と同じ意味になります。

    ktMultiCal(dtm開始日, dtm終了日, Date, 1, kt_なし)

(2) 『土日』を休業日表示する

    ktMultiCal(dtm開始日, dtm終了日, , ,kt_土日)

(3) 『土日』及び『祝日/振替休日』を休業日表示する

    ktMultiCal(dtm開始日, dtm終了日, , ,kt_土日祝)

(4) 『休日マップ』を指定

    ktMultiCal(dtm開始日, dtm終了日, , ,str休日Map)
      または
    ktMultiCal(dtm開始日, dtm終了日, , ,Rang("A1").Value)
                        ‥‥‥A1セルに休日マップデータが格納されている場合

(5) ある日付の「年月」で表示する。

    Dim dtm年月日 As Date
    dtm年月日 = DateValue("2000/2/20")

    ktMultiCal(dtm開始日, dtm終了日, dtm年月日)
      または
    ktMultiCal(dtm開始日, dtm終了日, DateValue("2000/2/20"))
      または
    ktMultiCal(dtm開始日, dtm終了日, "2000/2/20")
      または
    ktMultiCal(dtm開始日, dtm終了日, "平成13年2月20日")

    上記の例は､全て「2000年2月」で表示されます。

(6) テキストボックスやセルに入っている日付で表示する。

    ktMultiCal(dtm開始日, dtm終了日, TextBox1.Value)
      または
    ktMultiCal(dtm開始日, dtm終了日, Rang("B5").Value)

    TextBox1/B5セルの内容が【シリアル値/日付文字列】以外の場合は､
    本日日付が適用されます。

(7) 表示位置を指定する。

    ktMultiCal(dtm開始日, dtm終了日, , , ,100, 50)

    Excelウィンドウ内で「Left=100,Top=50 」の位置に表示します。


-- F5セルの付近に表示する(ktCell2Positionを利用) --
    Dim rc As Boolean
    Dim vntPos As Variant
    Dim vntTop As Variant
    Dim vntLeft As Variant
    vntPos = ktCell2Position(ActiveSheet.Range("F5"))
    If IsError(vntPos) Then
        'F5 セル が 表示範囲外 ⇒ Top/Left を省略
        vntTop = Empty
        vntLeft = Empty
    Else
        vntTop = vntPos(0) + 5
        vntLeft = vntPos(1) + 5
    End If
    rc = ktMultiCal(dtm開始日, dtm終了日, Pos_X:=vntLeft, Pos_Y:=vntTop)

(8) 入力Msg と入力制限の例

    ktMultiCal(dtm開始日, dtm終了日, Date, 1, kt_土日祝, , , _
                "開始日を入力してください", 1, "2001/12/16", "2002/1/15")


---- 利用コード例　-------------------------------
CommandButton1 をクリックするとカレンダーフォームを表示して､入力した日付を
「yyyy/m/d 」形式に編集してLabel1/Label2に設定します。表示の際は､既にLabel1に
日付文字列が設定されている場合は「その年月」で､空白や日付以外の文字列が設定さ
れていた場合は「本日の年月」で表示します。

Private Sub CommandButton1_Click()
Dim MyDate1 As Date
Dim MyDate2 As Date
    If ktMultiCal(MyDate1, MyDate2, Label1.Caption, 1, kt_土日祝) Then
        Label1.Caption = Format(MyDate1, "yyyy/m/d")    ' 開始日
        Label2.Caption = Format(MyDate2, "yyyy/m/d")    ' 終了日
    End If
End Sub

Private Sub CommandButton2_Click()    ' クリアボタン
    Label1.Caption = ""    ' 開始日
    Label2.Caption = ""    ' 終了日
End Sub