【Access VBA】フォームを画面中央に移動(絶対座標使用)

はじめに

Access VBAでフォームをメインディスプレイの画面中央に絶対座標で移動する方法を紹介します。

コード

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

'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

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

    Dim RectObject As RECT 'GetWindowRectの戻り値を格納するオブジェクト
    
    Dim widthScreen As Long 'メインディスプレイの画面の幅
    Dim heightScreen As Long 'メインディスプレイの画面の高さ
    
    Dim widthForm As Long 'フォームの幅
    Dim heightForm As Long 'フォームの高さ
    
    Dim leftPosition As Long 'フォームの左座標
    Dim topPosition As Long  'フォームの上座標
    
'メインディスプレイの幅・高さを取得
    widthScreen = GetSystemMetrics(SM_CXFULLSCREEN) 'メインディスプレイの画面の幅
    heightScreen = GetSystemMetrics(SM_CYFULLSCREEN) 'メインディスプレイの画面の高さ
    
'フォームの幅・高さを取得
    Call GetWindowRect(Forms(formName).hwnd, RectObject) 'フォームのRECTオブジェクト取得
    widthForm = RectObject.Right - RectObject.Left 'フォームの幅
    heightForm = RectObject.Bottom - RectObject.Top 'フォームの高さ
    
'移動後のフォームの横座標・縦座標を取得
    leftPosition = (widthScreen - widthForm) / 2 '画面中央に移動後のフォームの左座標(絶対座標)
    topPosition = (heightScreen - heightForm) / 2  '画面中央に移動後のフォームの上座標(絶対座標)

'フォームをメインディスプレイの画面中央に移動
    Call MoveWindow(Forms(formName).hwnd, leftPosition, topPosition, widthForm, heightForm, True)
    
End Sub

呼び出し側のコード

Sub test()
    Call MoveFormToCenterOfScreen("SampleForm")
End Sub