マクロのプロシージャ
Public Function myAutoExec() DoCmd.OpenForm "フォーム2", acNormal DoCmd.ShowToolbar "Ribbon", acToolbarNo End Function
フォームのプロシージャ
'フォームを開くとき Private Sub Form_Open(Cancel As Integer) SetWinStyle End Sub 'フォーム アクティブ時 Private Sub Form_Activate() DoCmd.Maximize End Sub 'フォーム 閉じるとき Private Sub Form_Close() DoCmd.Quit End Sub Private Sub 終了_Click() DoCmd.Close End Sub
使用するWIN32
'システムに関するパラメータを取得 (または設定) する関数 'lpvParamは参照でかえすため、ByValは不可 Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _ (ByVal uAction As Long, _ ByVal uParam As Long, _ lpvParam As Any, _ ByVal fuWinIni As Long) As Long '指定されたウィンドウの左上端と右下端の座標をスクリーン座標で取得 'スクリーン座標は、表示画面の左上端が (0,0) となる Private Declare PtrSafe Function GetWindowRect Lib "user32" _ (ByVal hWnd As Long, lpRect As RECT) As Long 'ウィンドウのクライアント領域の左上端と右下端の座標を取得 'クライアント座標はクライアント領域の左上端からの相対座標なので、左上端の座標は常に (0,0) Private Declare PtrSafe Function GetClientRect Lib "user32" _ (ByVal hWnd As Long, lpRect As RECT) As Long 'さまざまなシステムメトリックの値(表示要素の幅と高さ)とシステムの現在の構成を取得 '表示要素とは、ウィンドウの一部、またはシステムが表示する画面の一部を意味する 'すべてのサイズをピクセル単位で取得 Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 'RECT構造体の内容はピクセル Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type '子ウィンドウ、ポップアップウィンドウ、またはトップレベルウィンドウのサイズ、位置、 'および Z オーダーを変更する 'X,Y ウィンドウ左上隅の X 座標, X 座標を指定 ' トップレベルウィンドウはスクリーン座標で、子ウィンドウはクライアント座標で指定 'cx,cy クライアント領域のサイズではなくウインドウのサイズを指定 Private Declare PtrSafe 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 fuFlags As Long) As Long 'GetSystemMetricsの引数nIndex Private Const SM_CXFULLSCREEN = 16 '最大化したときのクライアント領域の幅 Private Const SM_CYFULLSCREEN = 17 '最大化したときのクライアント領域の高さ Private Const SM_CXMAXIMIZED = 61 '最大化したときのウィンドウの幅 Private Const SM_CYMAXIMIZED = 62 '最大化したときのウィンドウの高さ 'SystemParametersInfoの引数uAction Private Const SPI_GETWORKAREA = 48 '画面全体からタスクバーが占める領域を除いた部分の作業領域のサイズを取得 'GetDeviceCapsの引数nIndex Private Const LOGPIXELSX = 88 '水平1インチあたりのピクセル数 Private Const LOGPIXELSY = 90 '垂直1インチあたりのピクセル数 'GetWindowLongの引数nIndex Private Const GWL_STYLE = (-16) 'ウィンドウスタイル を取得する 'SetWindowLongの引数dwNewLong(新しく設定する値を指定) Private Const WS_MAXIMIZE = &H1000000 '最大表示されたウィンドウを作成 Private Const WS_MAXIMIZEBOX = &H10000 '最大表示ボタンを持つウィンドウを作成 Private Const WS_MINIMIZEBOX = &H20000 'アイコン化ボタンを持つウィンドウを作成 Private Const WS_THICKFRAME = &H40000 'ウィンドウのサイズ変更に使うことができる太い枠を持つウィンドウを作成 Private Const WS_SYSMENU = &H80000 'タイトル バーにコントロール メニュー ボックスを持つウィンドウを作成 'SetWindowPosの引数hWndInsertAfter Private Const HWND_TOP = &H0 'ウィンドウを Z オーダーの先頭に置く Private Const SWP_NOSIZE = &H1 '現在のサイズを維持する(cx パラメータと cy パラメータを無視する) Private Const SWP_NOMOVE = &H2 '現在の位置を維持する(X パラメータと Y パラメータを無視する) Private Const SWP_DRAWFRAME = &H20 'ウィンドウを囲む枠を描画する Private Const TWIPSPERINCH = 1440 '1 論理インチは1,440twip 1 論理cmは567twip
フォームの「開く時」に実行されるプロシージャ
Public Sub SetWinStyle() Dim WStyle As Long Dim hWnd As Long Dim wRECT As RECT Dim cRECT As RECT Dim w As Long, h As Long Dim mw As Long, mh As Long Dim nLogPixelsX As Long Dim nLogPixelsY As Long hWnd = Application.hWndAccessApp mw = GetSystemMetrics(SM_CXMAXIMIZED) mh = GetSystemMetrics(SM_CYMAXIMIZED) '取得の単位はpixel GetWindowRect hWnd, wRECT GetClientRect hWnd, cRECT 'GetDC(0)スクリーン全体のデバイスコンテキストを取得 '返りは論理インチ当たりのピクセル数 nLogPixelsX = GetDeviceCaps(GetDC(0), LOGPIXELSX) nLogPixelsY = GetDeviceCaps(GetDC(0), LOGPIXELSY) 'CodeContextObject.Width:フォームのウィンドウの幅 (twip単位) '幅をtwip単位→ピクセル単位に変換 w = CodeContextObject.Width / TWIPSPERINCH * nLogPixelsX '非クライアント領域を加算 w = w + wRECT.Right - wRECT.Left - cRECT.Right w = mw 'CodeContextObject.Section(acDetail).Height:フォームの詳細セクションのウィンドウの高さ (twip単位) 'フォームヘッダー・フッターなどがあれば適宜変更 '幅をtwip単位→ピクセル単位に変換 h = CodeContextObject.Section(acDetail).Height / TWIPSPERINCH * nLogPixelsY '非クライアント領域を加算 h = h + wRECT.Bottom - wRECT.Top - cRECT.Bottom h = mh WStyle = GetWindowLong(hWnd, GWL_STYLE) WStyle = WStyle And Not (WS_THICKFRAME Or WS_SYSMENU) SetWindowLong hWnd, GWL_STYLE, WStyle SetWindowPos hWnd, HWND_TOP, 0, 0, w, h, SWP_NOMOVE Or SWP_DRAWFRAME End Sub
フォームを画面中央に開く
フォームのプロパティシートのポップアップを「はい」とします。 「いいえ」とすると、アクセスのクライアント領域の中での中央となります。
'引数AFはフォームオブジェクトです。 Public Sub FormCenter(ByRef AF As Access.Form) Dim hWnd As Long Dim DeskRect As RECT Dim FormRect As RECT Call SystemParametersInfo(SPI_GETWORKAREA, 0&, DeskRect, 0&) hWnd = AF.hWnd Call GetWindowRect(hWnd, FormRect) Call SetWindowPos(hWnd, _ HWND_TOP, _ (DeskRect.Right - DeskRect.Left - (FormRect.Right - FormRect.Left)) / 2, _ (DeskRect.Bottom - DeskRect.Top - (FormRect.Bottom - FormRect.Top)) / 2, _ 0, _ 0, _ SWP_NOSIZE) End Sub