Windows 10 Pro x64 + Excel2016 x86 VBA で CalenderForm を試してみる

#目的
[Windows 10 Pro x64 + Excel2016 x86 VBA + DTPicker を試してみる](https://qiita.com/tabizou/items/9001ba288091ddd33901)
常に DTPicker が使える環境とは限らないので、カレンダー用のフォームを作成する
いや　しようと思ったのだけど[ExcelVBAでカレンダーコントロールを自作する](https://ateitexe.com/excel-vba-calendar-control/)で公開され
ているCalenderForm1.xlsm をベースに使用させていただきます(休日のサポートは未対応)
※日付の表示が0フィルの4/2/2形式じゃないとな　と思うのはなぜなんだろう？
##CalenderForm1のコードの修正点
・Option Explicit 付きでコンパイルが通る
・setCallBackControl関数で使用可能なように修正
・それに伴い UserForm_Initialize の内容を移動
・細かい部分の修正(コメント含む)
##作成手順
・UserFormを1個追加する
・UserFormの上にテキストボックスを1個追加する
・UserFormの上にコマンドボタンを1個追加する
・DLしたCalenderForm1.xlsmよりCalenderFormをフォームにコピーする
・CalenderFormのコードを修正する
##サンプルコード
```vb

Option Explicit

Private Sub UserForm_Initialize()
'
    TextBox1.Text = Date
'
End Sub

Private Sub CommandButton1_Click()
'
    Dim strDate     As String
    '
    '   4桁数字/2桁数字/2桁数字 の並びになっているかを
    '   チェックするのが良いのかどうか　迷うところ
    '
'    If Trim(TextBox1.Text) Like "19[0-9][0-9]/[0|1][0-2]/[0-3][0-9]" _
'    Or Trim(TextBox1.Text) Like "20[0-9][0-9]/[0|1][0-2]/[0-3][0-9]" Then
    If Len(Trim(TextBox1.Text)) > 0 Then
        If IsDate(TextBox1.Text) Then
            strDate = TextBox1.Text
        Else
            strDate = Date
        End If
    Else
        strDate = Date
    End If
'
    Call CalenderForm.setCallBackControl(strDate, TextBox1)
    Call CalenderForm.Show
'
End Sub
```
CalenderForm(オリジナルに一部コードを修正したもの)

```vb

Option Explicit

Dim clndr_date      As Date
Dim outCtrl         As Control

'=================================================================
' 機 能 : メインフォームからのパラメータと出力用のTextBox1
'=================================================================
Public Sub setCallBackControl(atxtDate As String, ByVal inRetCtrl As Control)

    Dim i As Integer
    '
    '   引数は Control で宣言する
    '
    clndr_date = CDate(atxtDate)
    Set outCtrl = inRetCtrl
    '
    '   前後3年分の年を登録
    '
    For i = -3 To 3
        Me.ComboBox1.AddItem CStr((Year(clndr_date)) + i)
    Next i
    '
    '   月を登録
    '
    For i = 1 To 12
        Me.ComboBox2.AddItem CStr(i)
    Next i
'
    Me.ComboBox1 = Year(clndr_date)     '年を指定
    Me.ComboBox2 = Month(clndr_date)    '月を指定

End Sub

'=================================================================
' 機 能 : 年が変更されたときの処理
'=================================================================
Private Sub ComboBox1_Change()
  Call Clndr_set
End Sub
 
'=================================================================
' 機 能 : 月が変更されたときの処理
'=================================================================
Private Sub ComboBox2_Change()
  Call Clndr_set
End Sub
 
'=================================================================
' 機 能 : カレンダーの作成と表示
'=================================================================
Private Sub Clndr_set()
'
    Dim yy        As Integer
    Dim mm        As Integer
    Dim i         As Integer
    Dim n         As Integer
    Dim endDay    As Integer
    '
    '   年か月どちらか入ってなければ中止
    '
    If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Then Exit Sub
    yy = Me.ComboBox1 '年
    mm = Me.ComboBox2 '月
    '
    '   ラベルの初期化
    '
    For i = 1 To 37
        Me("Label" & i).Caption = ""
        Me("Label" & i).BackColor = Me.BackColor
    Next
    '
    '   その月の1日の曜日番号に、マイナス1したもの
    '
    n = Weekday(yy & "/" & mm & "/" & 1) - 1
    '
    '   月末日の算出：次月の開始日 - 1日
    '
    endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1")))
    '
    '   TextBoxの日と同じなら色をつける
    '
    For i = 1 To endDay
        Me("Label" & i + n).Caption = i '日を入れる
        If CDate(yy & "/" & mm & "/" & i) = clndr_date Then Me("Label" & i + n).BackColor = RGB(200, 200, 200)
    Next
'
End Sub

'=================================================================
' 機 能 : ひと月戻る
'=================================================================
Private Sub SpinButton1_SpinUp()
'
    If Me.ComboBox2 = 1 Then '1月だったら
        Me.ComboBox1 = Me.ComboBox1 - 1 '年-1
        Me.ComboBox2 = 12 '12月へ
    Else
        Me.ComboBox2 = Me.ComboBox2 - 1
    End If
'
End Sub
 
'=================================================================
' 機 能 : ひと月進む
'=================================================================
Private Sub SpinButton1_SpinDown()
'
    If Me.ComboBox2 = 12 Then '12月だったら
        Me.ComboBox1 = Me.ComboBox1 + 1 '年+1
        Me.ComboBox2 = 1 '1月へ
    Else
        Me.ComboBox2 = Me.ComboBox2 + 1
    End If
'
End Sub

'=================================================================
' 機 能 : 日付(ラベル)が押下されたときの処理
'       : 形式は yyyy/mm/dd(4桁/2桁/2桁) に統一する
'=================================================================
Private Sub LabelClick(ByVal i As Integer)
'
  If Len(Me("Label" & i).Caption) = 0 Then
        '
        '   ブランク押下時は引数として渡された日付をコントールにセット
        '
        outCtrl = Format(clndr_date, "yyyy/mm/dd")
    Else
        '
        '   日付を生成してコントールにセット
        '
        outCtrl = Me.ComboBox1 & "/" & Right("0" & Me.ComboBox2, 2) & "/" & Right("0" & Me("Label" & i).Caption, 2)
    End If
'
    Unload Me
  
End Sub
 
Private Sub Label1_Click(): Call LabelClick(1): End Sub
Private Sub Label2_Click(): Call LabelClick(2): End Sub
Private Sub Label3_Click(): Call LabelClick(3): End Sub
Private Sub Label4_Click(): Call LabelClick(4): End Sub
Private Sub Label5_Click(): Call LabelClick(5): End Sub
Private Sub Label6_Click(): Call LabelClick(6): End Sub
Private Sub Label7_Click(): Call LabelClick(7): End Sub
Private Sub Label8_Click(): Call LabelClick(8): End Sub
Private Sub Label9_Click(): Call LabelClick(9): End Sub
Private Sub Label10_Click(): Call LabelClick(10): End Sub
Private Sub Label11_Click(): Call LabelClick(11): End Sub
Private Sub Label12_Click(): Call LabelClick(12): End Sub
Private Sub Label13_Click(): Call LabelClick(13): End Sub
Private Sub Label14_Click(): Call LabelClick(14): End Sub
Private Sub Label15_Click(): Call LabelClick(15): End Sub
Private Sub Label16_Click(): Call LabelClick(16): End Sub
Private Sub Label17_Click(): Call LabelClick(17): End Sub
Private Sub Label18_Click(): Call LabelClick(18): End Sub
Private Sub Label19_Click(): Call LabelClick(19): End Sub
Private Sub Label20_Click(): Call LabelClick(20): End Sub
Private Sub Label21_Click(): Call LabelClick(21): End Sub
Private Sub Label22_Click(): Call LabelClick(22): End Sub
Private Sub Label23_Click(): Call LabelClick(23): End Sub
Private Sub Label24_Click(): Call LabelClick(24): End Sub
Private Sub Label25_Click(): Call LabelClick(25): End Sub
Private Sub Label26_Click(): Call LabelClick(26): End Sub
Private Sub Label27_Click(): Call LabelClick(27): End Sub
Private Sub Label28_Click(): Call LabelClick(28): End Sub
Private Sub Label29_Click(): Call LabelClick(29): End Sub
Private Sub Label30_Click(): Call LabelClick(30): End Sub
Private Sub Label31_Click(): Call LabelClick(31): End Sub
Private Sub Label32_Click(): Call LabelClick(32): End Sub
Private Sub Label33_Click(): Call LabelClick(33): End Sub
Private Sub Label34_Click(): Call LabelClick(34): End Sub
Private Sub Label35_Click(): Call LabelClick(35): End Sub
Private Sub Label36_Click(): Call LabelClick(36): End Sub
Private Sub Label37_Click(): Call LabelClick(37): End Sub
```