access カレンダー 常に表示する

Question

前提・実現したいこと

https://hatenachips.blog.fc2.com/blog-entry-191.html
こちらのサイトを参考にして、常に表示されるカレンダーを作成しています。
（access2007までにあったカレンダコントロールのようなものです。）

上記サイトで紹介されているものは、日付の入ったテキストボックスをクリック時にその日付を取得して
カレンダーフォームを開き、カレンダーをクリックしてテキストボックスに日付を反映させています。

日付のテキストボックスをクリックしてカレンダーを表示するのではなく、
常にカレンダー表示して、クリックした際に日付のテキストボックスに日付を反映させてあげたいと思っています。

追記
サブフォームとして、ほかのフォームにカレンダーを張り付けてカレンダーを利用したいと考えています。

発生している問題・エラーメッセージ

該当のソースコード

'フォーム 開くとき
Private Sub Form_Open(Cancel As Integer)
    Dim i As Integer
    
    Dim WindowHandle        As Long
    Dim DeviceContextHandle As Long
    Dim aRect               As RECT
    Dim PixelToInchX        As Long
    Dim PixelToInchY        As Long
    Dim X                   As Long     '左位置
    Dim Y                   As Long     '上位置
    Dim WorkAreaRight       As Integer
    Dim WorkAreaBottom      As Integer

    WindowHandle = GetFocus()
    If WindowHandle = 0 Then Exit Sub

    GetWindowRect WindowHandle, aRect

    DeviceContextHandle = GetDC(WindowHandle)
    PixelToInchX = GetDeviceCaps(DeviceContextHandle, LOGPIXELSX)
    PixelToInchY = GetDeviceCaps(DeviceContextHandle, LOGPIXELSY)

    X = (aRect.Right / PixelToInchX) * INCH_TO_TWIP
    Y = (aRect.Top / PixelToInchX) * INCH_TO_TWIP
    ReleaseDC WindowHandle, DeviceContextHandle

    SystemParametersInfo SPI_GETWORKAREA, 0&, aRect, 0&
    WorkAreaRight = (aRect.Right / PixelToInchX) * INCH_TO_TWIP
    WorkAreaBottom = (aRect.Bottom / PixelToInchX) * INCH_TO_TWIP
   

   'ここでフォーカスが来ているテキストボックスの日付を取得していると思うのですが、
　 'テキストボックスをクリックしないでカレンダーを表示させたいので、別の方法で取得したい。
    Set ctl = Screen.ActiveControl
    If X + Me.WindowWidth > WorkAreaRight Then X = X - Me.WindowWidth - ctl.Width
    If Y + Me.WindowHeight > WorkAreaBottom Then Y = WorkAreaBottom - Me.WindowHeight
    Me.SetFocus
    DoCmd.MoveSize X, Y
    
    For i = 1 To 42
        Me("D" & i).OnClick = "=SetDate(" & i & ")"
    Next
    Me.cmdPrev.OnClick = "=MoveMonth(-1)"
    Me.cmdNext.OnClick = "=MoveMonth(1)"
    
    If IsDate(ctl.Value) Then
        SetCalendar CDate(ctl.Value)
    Else
        SetCalendar Date
    End If
End Sub

試したこと

[Forms]![日報]!日付2.SetFocus
[Forms]![日報]!日付2.Value = "2020/03/11"
Set ctl = Screen.ActiveControl
'別のテキストボックスに日付を入力して、フォーカスをしてみたがctlに日付が入らなかった。

openプロシージャを色々と変更したができなかった。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Comments

[sazi]

リンク先では、紐付けるコントロールのイベントから呼び出していると思うんですが、常に表示させるためにこのForm_Openはどのタイミングで呼び出すようにしているんですか？

[yama0131]

説明が足りていませんでした。
カレンダーはサブフォームとして別のフォームに表示したいと考えています。
なので、イベントがあって開くのではなく、別方法で実行できればと思ったのですが
難しいでしょうか。

[sazi]

フォーカス取得時のイベントで開く設定で回答しましたが、そうじゃない場合、一体どこで開く設定を行うつもりですか？
リンク先では、activeconntrolで制御しているので、コントロールのイベントでない場合には値を返却するコントロールに結び付ける必要がありますけど、その辺の考慮はどのように？

Answer 1

サブフォームとして、ほかのフォームにカレンダーを張り付けてカレンダーを利用したいと考えています。

下記の手順でどうぞ。

カレンダーダイアログ日付入力関数　祝日表示対応版 - hatena chips
のサンプルデータベースファイルの F_Calendar フォームを使用したいデータベースファイルにインポートします。
名前を F_CalendarSubForm に変更します。

フォームの開くときのイベントプロシージャを削除します。（Private Sub Form_Open(Cancel As Integer)・・・）
代わりに下記の関数を貼り付けてください。

'親フォームから呼び出される初期化関数
Public Sub Form_Init(DateTextBox As Control)
    
    Set ctl = DateTextBox
    Debug.Print Parent.Name
    Dim i As Integer
    For i = 1 To 42
        Me("D" & i).OnClick = "=SetDate(" & i & ")"
    Next
    Me.cmdPrev.OnClick = "=MoveMonth(-1)"
    Me.cmdNext.OnClick = "=MoveMonth(1)"
    
    If IsDate(ctl.Value) Then
        SetCalendar CDate(ctl.Value)
    Else
        SetCalendar Date
    End If
End Sub

入力フォームのテキストボックス名を「txt日付」とします。
このフォーム上に F_CalendarSubForm をドラッグ＆ドロップしてサブフォームとして配置します。
サブフォームコントロール名は「CalendarSubForm1」とします。
入力フォームの読み込み時のイベントプロシージャを下記のように記述します。

Private Sub Form_Load()
    On Error Resume Next
    Dim F As Form
    Set F = Me.CalendarSubForm1.Form
    If Err = 0 Then F.Form_Init Me.txt日付
End Sub

以上です。

Answer 2

良く分かりませんけど、「常に表示」がフォーカスがある時という事なら、フォーカス取得イベントに

=CallCalendar()

とかを設定すれば良いんじゃないでしょうか？