【 ktPasteCal 】

ユーザーフォーム上にカレンダーを貼り付けるサブルーチンです。
フレームだけ用意すれば、ktPasteCal が、その中にカレンダーを作り込みます。

【 構 文 】

Call ktPasteCal(

BaseDate, MyFrame, [MonToSun], [休日Map] )

BaseDate	‥‥‥	Variant(Date) 型
MyFrame	‥‥‥	オブジェクト 型(Frameコントロール)
MonToSun	‥‥‥	Boolean 型(省略可、既定値：False )
休日Map	‥‥‥	String 型(省略可)

【 パラメータ 内容 】

BaseDate	‥‥‥	作成する月の 「１日」 を表すシリアル値 または 日付文字列を指定します。 （年月 の 指定用ですので、特に １日 でなくても構いません） ※ 新元号「令和」対応になっていない環境でも     「令和 日付文字列(元年 表記を含む)」を指定可能です。 日付の値が不正の場合は、暦を作成せずに終了します。
MyFrame	‥‥‥	UserForm上に用意したフレームコントロールを指定する。 引数への書き方は『 Me．Frame1 』等とする。 フレームコントロールの属性は解説を参照。
MonToSun	‥‥‥	省略/Flase ： 『 日・月〜土 』並び True          ： 『 月〜土・日 』並び
休日Map	‥‥‥	休業日表示（背景ピンクで強調）を付ける場合に指定します。 省略すると「休業日表示なし」となります。指定内容はこちらを参照

【 解 説 】

  『ktPasteCal 』は、ユーザーフォーム上にカレンダーをダイナミックに貼り付けるサブルーチン
です。フレームコントロールさえ用意すれば、後は『ktPasteCal 』を呼び出すだけで、そのフレ
ーム内にカレンダーを作成/貼付けます。　

  貼り付けられたカレンダーは、スピンボタンと組み合わせることで『月表示』を切り替える事も
出来ます（使用例参照）。カレンダーには祝日表示も付けてあります。

  『ktPasteCal 』で作成するカレンダーは日付入力用には使えません。あくまでユーザーフォーム
を飾るアクセサリーとして利用して下さい。

  祝日の日にマウスを合わせると、祝日名を表示します。年月にマウスを合わせると、和暦/干支
/和風月名を表示します。1900年以前の年でも動作します。

  UserForm上に用意するFrameコントロールは下記の条件で定義します。
      ・キャプション無し
      ・[Height = 105]
      ・[Width = 108]
      ・上記以外のプロパティ（枠や背景色など）は任意です。
      （注）ひとつのフレーム内に作成できるのは『１ヶ月分』です。

  複数月のカレンダーを作成する場合は、その月数分のフレームコントロールを用意してください。
ktPasteCal がフレーム内に作成するのは全てラベルコントロールです。そのラベルのオブジェクト
名には、フレーム名をプリフィックスとして付してありますので、フレームを幾つ用意しても名前が
重複する事はありません。



  万年暦を作る場合は、１２ヶ月分のカレンダーが必要ですから、フレームを１２個用意する必要が
あります。尚、この場合、ユーザーフォームを表示する際に、フレームが多い為にエクセルが作業
バッファ確保を行なっていると思われるディスク動作が発生するかもしれません（ktPasteCalは、一切
ディスクアクセスに繋がるような処理は行なっていません）。

【 使 用 例 】

  『休日マップ作成フォーム』の確認用カレンダーで利用しています。

  『体験kt関数.xls 』にサンプルマクロを収録してありますので、そちらも参考にしてください（下記参照）。

  月表示を切り替える機能を持たせたい場合には、上図のようにフレームコントロール内の
『右上隅』にSpinButtonコントロールを配置します。
  このSpinButtonコントロールをクリックする都度、日付を１ヶ月前後させて『ktPasteCal 』を
再度実行させる事により月表示が変わります。


'============================== 最初から表示するケース ===========
Private Frame3用日付 As Date    ' InitializeとSpinButton3で共有なのでPrivate

Private Sub UserForm_Initialize()
    Frame3用日付 = Date
    Call ktPasteCal(Frame3用日付, Me.Frame3)
End Sub

Private Sub SpinButton3_SpinDown()
    Frame3用日付 = DateAdd("m", -1, Frame3用日付)
    Call ktPasteCal(Frame3用日付, Me.Frame3)
End Sub

Private Sub SpinButton3_SpinUp()
    Frame3用日付 = DateAdd("m", 1, Frame3用日付)
    Call ktPasteCal(Frame3用日付, Me.Frame3)
End Sub


'============== テキストボックスで初期日付を指定するケース ========
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If (Trim(TextBox1.Value) = "") Then
        Exit Sub
    ElseIf IsDate(TextBox1.Value) Then
        Call ktPasteCal(DateValue(TextBox1.Value), Me.Frame1)
    Else
        Beep
        Cancel = True
    End If
End Sub

Private Sub SpinButton1_SpinDown()
    If (Trim(TextBox1.Value) = "") Then
        Beep
        Exit Sub
    End If
    TextBox1.Value = _
          Format(DateAdd("m", -1, DateValue(TextBox1.Value)), "yyyy/m/d")
    Call ktPasteCal(DateValue(TextBox1.Value), Me.Frame1)
End Sub

Private Sub SpinButton1_SpinUp()
    If (Trim(TextBox1.Value) = "") Then
        Beep
        Exit Sub
    End If
    TextBox1.Value = _
            Format(DateAdd("m", 1, DateValue(TextBox1.Value)), "yyyy/m/d")
    Call ktPasteCal(DateValue(TextBox1.Value), Me.Frame1)
End Sub


'===========================　万年暦のマクロ　==================
' UserForm上には１年分として[Frame1]〜[Frame12]の１２個のフレーム
' コントロールが用意してあります
' TextBox1 に『年』を入力します

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If (Trim(TextBox1.Value) = "") Then
        Exit Sub
    ElseIf IsNumeric(TextBox1.Value) Then
        If (CInt(TextBox1.Value) >= 100) Then
            Call 年間暦
        Else
            Beep
            Cancel = True
        End If
    Else
        Beep
        Cancel = True
    End If
End Sub

Private Sub CheckBox1_Click()
    '[月〜土日]表示用CheckBox
    If (Trim(TextBox1.Value) = "") Then
        '何もしない
    ElseIf Not IsNumeric(TextBox1.Value) Then
        '何もしない
    Else
        Call 年間暦
    End If
End Sub

Private Sub SpinButton1_SpinDown()
    If (Trim(TextBox1.Value) = "") Then
        Beep
    ElseIf Not IsNumeric(TextBox1.Value) Then
        Beep
    Else
        If (CInt(TextBox1.Value) > 100) Then
            TextBox1.Value = CInt(TextBox1.Value) - 1
            Call 年間暦
    Else
        Beep
    End If
End If End Sub

Private Sub SpinButton1_SpinUp()
    If (Trim(TextBox1.Value) = "") Then
        Beep
    ElseIf Not IsNumeric(TextBox1.Value) Then
        Beep
    Else
        TextBox1.Value = CInt(TextBox1.Value) + 1
        Call 年間暦
    End If
End Sub

Private Sub 年間暦()
Dim i As Integer
Dim MyDate As Date
    For i = 1 To 12
        MyDate = DateSerial(CInt(TextBox1.Value), i, 1)
        Call ktPasteCal(MyDate, Me.Controls("Frame" & i), CheckBox1.Value)
    Next i
End Sub