乐胖代购免代理版

フォームの表示位置を指定する

Windows APIを使ってフォームの表示位置を指定します。下記リンク先にて作成したカレンダーコントロールの表示位置が呼び出し元フォームのテキストボックスの位置に連動して変わるようにします。
【Access VBA】カレンダーコントロールの作成 - カットマンブログ

twipをpixelに変換する関数の記述

テキストボックスの位置がtwip単位で取得されるため、これをpixelに変換する関数を標準モジュールに記述します。下記サイトよりコピペしました。
Access VBA Form の位置、サイズはtwip単位で係数は567である #access - Qiita

Public Const SM_CYCAPTION As Long = 4
Public Const SM_CXFIXEDFRAME As Long = 7
Public Const SM_CYFIXEDFRAME As Long = 8
Public Const SM_CXFULLSCREEN As Long = 16
Public Const SM_CYFULLSCREEN As Long = 17
Public Const WU_LOGPIXELSX = 88
Public Const WU_LOGPIXELSY = 90

Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, ByRef lpRect As RECT) As LongPtr
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPtr
Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As LongPtr
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public meRect_parent As RECT
Public meRect_client As RECT
Public ownerRect As RECT

Public Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
   'Handle to device
   Dim lngDC As Long
   Dim lngPixelsPerInch As Long
   Const nTwipsPerInch = 1440
   lngDC = GetDC(0)
   If (lngDirection = 0) Then       'Horizontal
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
   Else                            'Vertical
      lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End If
   lngDC = ReleaseDC(0, lngDC)
   ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function

カレンダーフォームの開く時のイベントプロシージャの記述

Fカレンダーの開く時のイベントプロシージャに以下のコードを記述します。
Fカレンダーが画面の右側にはみ出す場合に、Fカレンダーの右端がテキストボックスの右端にくるようにしています。
Fカレンダーが画面の下側にはみ出す場合に、Fカレンダーの下端がテキストボックスの上端にくるようにしています。

Private Sub Form_Open(Cancel As Integer)
    Dim leftPosition As Long
    Dim topPosition As Long
    Dim oForm As Object
    Set oForm = Forms(Application.CurrentObjectName)

    GetWindowRect Forms(Application.CurrentObjectName).hwnd, ownerRect

    Dim meWidth_parent As Long
    Dim meHeight_parent As Long
    GetWindowRect Me.hwnd, meRect_parent
    GetClientRect Me.hwnd, meRect_client
    With meRect_parent
        meWidth_parent = .Right - .Left 'Fカレンダーの幅
        meHeight_parent = .Bottom - .Top 'Fカレンダーの高さ
    End With
    Dim leftPosition_owner As Long
    Dim topPosition_owner As Long
    Dim xframeWidth As Long
    Dim titleHeight As Long
    Dim leftPosition_textbox As Long
    Dim topPosition_textbox As Long
    Dim textboxWidth As Long
    Dim textboxHeight As Long
    Dim screenWidth As Long
    Dim screenHeight As Long
    Dim meWidth_client As Long
    Dim meHeight_client As Long
    leftPosition_owner = ownerRect.Left '呼び出し元フォームの左位置
    topPosition_owner = ownerRect.Top '呼び出し元フォームの上位置
    xframeWidth = GetSystemMetrics(SM_CXFIXEDFRAME) 'ウインドウの水平罫線の太さ
    titleHeight = GetSystemMetrics(SM_CYCAPTION) 'タイトルバーの高さ
    screenWidth = GetSystemMetrics(SM_CXFULLSCREEN) '全画面表示ウインドウのクライアント領域の幅
    screenHeight = GetSystemMetrics(SM_CYFULLSCREEN) '全画面表示ウインドウのクライアント領域の高さ
    meWidth_client = meRect_client.Right 'Fカレンダーのクライアント領域の幅
    meHeight_client = meRect_client.Bottom 'Fカレンダーのクライアント領域の高さ
    
    With oForm.Controls(OpenArgs)
        leftPosition_textbox = ConvertTwipsToPixels(.Left, 0) 'テキストボックスの左位置
        topPosition_textbox = ConvertTwipsToPixels(.Top, 1) 'テキストボックスの上位置
        textboxWidth = ConvertTwipsToPixels(.Width, 0) 'テキストボックスの幅
        textboxHeight = ConvertTwipsToPixels(.Height, 1) 'テキストボックスの高さ
    End With
        If leftPosition_owner + leftPosition_textbox > screenWidth - meWidth_parent Then
            leftPosition = leftPosition_owner + leftPosition_textbox + textboxWidth - meWidth_client
        Else
            leftPosition = leftPosition_owner + leftPosition_textbox
        End If
        
        If topPosition_owner + xframeWidth + titleHeight + topPosition_textbox + textboxHeight > screenHeight - meHeight_parent Then
            topPosition = topPosition_owner + topPosition_textbox - meHeight_client
        Else
            topPosition = topPosition_owner + xframeWidth + titleHeight + topPosition_textbox + textboxHeight
        End If

    MoveWindow Me.hwnd, leftPosition, topPosition, meWidth_parent, meHeight_parent, True
End Sub

呼び出し元フォームのボタンクリック時イベントプロシージャの修正

呼び出し元フォームのボタンクリック時イベントプロシージャのOpenFormメソッドのOpenArgs引数にテキストボックスの名前を追加しました。

Private Sub btnCalendar_Click()
        sDate = Nz(txtDate, 0)
        DoCmd.OpenForm "Fカレンダー", , , , , acDialog, "txtDate"
        If sDate <> 0 Then
            txtDate = sDate
        End If
End Sub