access2010 access2007 アプリケーションウィンドウの中央寄せ -1-

うむ。これは使うことあるので加工させてもらった。

元ネタは、Accessウィンドウをディスクトップの中央に表示する(hatena chips)
マルチモニタ環境で使いたかったので。だけどデュアルモニタまでしか確認してない。

Option Compare Database
Option Explicit

'デュアルモニタまでしか確認してない
'original：http://hatenachips.blog34.fc2.com/blog-entry-318.html

Private Const MONITOR_DEFAULTTONEAREST = &H2
Private Const MONITOR_DEFAULTTONULL = &H0
Private Const MONITOR_DEFAULTTOPRIMARY = &H1
Private Const HWND_TOP = &H0
Private Const SWP_NOSIZE = &H1

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

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

#If VBA7 Then
'http://msdn.microsoft.com/ja-jp/library/cc428707.aspx
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As LongPtr, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long

'http://msdn.microsoft.com/ja-jp/library/cc410476.aspx
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal dwFlags As Long _
                                        ) As Long

Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpRect As RECT _
                                        ) As Long

Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal hWndInsertAfter As LongPtr, _
                                        ByVal x As Long, _
                                        ByVal y As Long, _
                                        ByVal cx As Long, _
                                        ByVal cy As Long, _
                                        ByVal wFlags As Long _
                                        ) As Long
#Else
Private Declare Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As Long, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long

Private Declare Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As Long, _
                                        ByVal dwFlags As Long _
                                        ) As Long

Private Declare Function GetWindowRect Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpRect As RECT _
                                        ) As Long

Private Declare Function SetWindowPos Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        ByVal hWndInsertAfter As Long, _
                                        ByVal x As Long, _
                                        ByVal y As Long, _
                                        ByVal cx As Long, _
                                        ByVal cy As Long, _
                                        ByVal wFlags As Long _
                                        ) As Long
#End If

Function AppWindowCentering()
    Dim mi As MONITORINFO, mRect As RECT, aRect As RECT
#If VBA7 Then
    Dim hMonitor As LongPtr, ApphWnd As LongPtr
#Else
    Dim hMonitor As Long, ApphWnd As Long
#End If
    ApphWnd = Application.hWndAccessApp
    GetWindowRect ApphWnd, aRect
    hMonitor = MonitorFromWindow(ApphWnd, MONITOR_DEFAULTTONEAREST)
    mi.cbSize = LenB(mi)
    GetMonitorInfo hMonitor, mi
    mRect = mi.rcWork
    SetWindowPos ApphWnd, HWND_TOP, _
                (mRect.Right + mRect.Left - aRect.Right + aRect.Left) / 2, _
                (mRect.Bottom + mRect.Top - aRect.Bottom + aRect.Top) / 2, _
                0, 0, SWP_NOSIZE
End Function

Sub AppWindowCentering()
    Dim mi As MONITORINFO, mRect As RECT, aRect As RECT
#If VBA7 Then
    Dim hMonitor As LongPtr, ApphWnd As LongPtr
#Else
    Dim hMonitor As Long, ApphWnd As Long
#End If
    ApphWnd = Application.hWndAccessApp
    GetWindowRect ApphWnd, aRect
    hMonitor = MonitorFromWindow(ApphWnd, MONITOR_DEFAULTTONEAREST)
    mi.cbSize = LenB(mi)
    GetMonitorInfo hMonitor, mi
    mRect = mi.rcWork
    Dim aw As Long, ah As Long, mw As Long, mh As Long
    aw = aRect.Right - aRect.Left: ah = aRect.Bottom - aRect.Top
    mw = mRect.Right - mRect.Left: mh = mRect.Bottom - mRect.Top
    If aw > mw Then aw = mw
    If ah > mh Then ah = mh
    Debug.Print aw; ah
    SetWindowPos ApphWnd, HWND_TOP, _
                (mRect.Right + mRect.Left - aw) / 2, _
                (mRect.Bottom + mRect.Top - ah) / 2, _
                aw, ah, &H40
End Sub

考え中

アプリケーションウインドウが最大化しているときとか考えてなかった。
GetWindowPlacement/SetWindowPlacementに切り替えを考えとこ。やってみた。