(祝)東京オリンピック!

(祝)北京オリンピック!

最大化してアクセスを開

マクロのプロシージャ



   

COPY

Public Function myAutoExec()

    DoCmd.OpenForm "フォーム2", acNormal

    DoCmd.ShowToolbar "Ribbon", acToolbarNo

End Function

フォームのプロシージャ



   

COPY

'フォームを開くとき
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



   

COPY

'システムに関するパラメータを取得 (または設定) する関数
'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

フォームの「開く時」に実行されるプロシージャ



   

COPY

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

フォームを画面中央に開く

フォームのプロパティシートのポップアップを「はい」とします。 「いいえ」とすると、アクセスのクライアント領域の中での中央となります。



   

COPY

'引数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