【Access VBA】フォームの絶対座標を取得しフォームを画面中央に移動する

Option Compare Database
Option Explicit

Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, ByRef lpRect As RECT) As LongPtr
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
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

Private Const SM_CXFULLSCREEN As Long = 16
Private Const SM_CYFULLSCREEN As Long = 17

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'フォームをメインディスプレイの画面中央に移動
Sub MoveFormToCenterOfScreen()

    Dim RectObject As RECT
    
    Dim widthScreen As Long
    Dim heightScreen As Long
    
    Dim leftPosition As Long
    Dim topPosition As Long
    Dim rightPosition As Long
    Dim bottomPosition As Long
    
    Dim widthForm As Long
    Dim heightForm As Long
    
'フォームの絶対座標の位置を取得
    Call GetWindowRect(Forms("フォーム1").hwnd, RectObject) 'フォームのRECTオブジェクト取得
    leftPosition = RectObject.Left 'フォームの左座標(絶対座標)
    topPosition = RectObject.Top 'フォームの上座標(絶対座標)
    rightPosition = RectObject.Right 'フォームの右座標(絶対座標)
    bottomPosition = RectObject.Bottom 'フォームの下座標(絶対座標)
    widthForm = RectObject.Right - RectObject.Left 'フォームの幅
    heightForm = RectObject.Bottom - RectObject.Top 'フォームの高さ

'フォームをメインディスプレイの画面中央に移動
    widthScreen = GetSystemMetrics(SM_CXFULLSCREEN) 'メインディスプレイの画面の幅
    heightScreen = GetSystemMetrics(SM_CYFULLSCREEN) 'メインディスプレイの画面の高さ
    leftPosition = (widthScreen - widthForm) / 2 'フォームを画面中央に移動する場合のフォームの左座標(絶対座標)
    topPosition = (heightScreen - heightForm) / 2  'フォームを画面中央に移動する場合のフォームの上座標(絶対座標)
    Call MoveWindow(Forms("フォーム1").hwnd, leftPosition, topPosition, widthForm, heightForm, True) 'フォームを画面中央に移動
    
End Sub