【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

'GetSystemMetricsの引数
Private Const SM_CXFULLSCREEN As Long = 16 '用途：メインディスプレイの画面の幅 取得
Private Const SM_CYFULLSCREEN As Long = 17 '用途：メインディスプレイの画面の高さ 取得

'GetWindowRectの戻り値を格納するユーザー定義型
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

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

    Dim RectObject As RECT 'GetWindowRectの戻り値を格納するオブジェクト
    
    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