獲取和設置ACCESS主窗體大小及位置代碼

獲取和設置Access主窗體大小及位置代碼
'//按 ALT+F11 轉到 vba 界面，
'//新建一個模塊
'//將以下代碼 COPY 進去
'//將光標停在 Function RunTest() 這行
'//按 F5 即可運行
'//運行結束後轉到 Access 使用界面，即可看到效果
'-----------------------------------------------
'自定義數據類型，GetAccessWindow的返回值
Public Type AWPix
    Left As Long
    Top As Long
    Width As Long
    Height As Long
End Type

'-----------------------------------------------
'獲取、設置 Window狀態的API
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
    ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Type RECT '屏幕坐標中隨同窗口裝載的矩形
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'-----------------------------------------------
'獲取分辯率設置的 API
Public Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const DIRECTION_VERTICAL = 1
Public Const DIRECTION_HORIZONTAL = 0


'-----------------------------------------------
'獲取窗體縮放狀態的 API
'縮放狀態
Public Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
'是否最小化
Public Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
'是否可見
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long


'---------------------------------------------
'設置窗體狀態的 API
Public Const SW_HIDE = 0            '隱藏
Public Const SW_SHOWNORMAL = 1      '普通（還原）
Public Const SW_SHOWMINIMIZED = 2   '最小化
Public Const SW_SHOWMAXIMIZED = 3   '最大化

Public Declare Function apiShowWindow Lib "user32" _
    Alias "ShowWindow" (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) As Long
'----------------------------------------------

'像素轉換成缇，本站以前文章中已經介紹過了。
'    關於單位“缇”與“像素”的轉換，以及缇與其他單位（例如：厘米）之間的轉換《窗體》
'    http://Access911.Net/index.ASP?u1=a&u2=72FAB41E13DCE9F3
Function PixelsToTwips(rlngPixels As Long, rlngDirection As Long) As Long
On Error GoTo PixelsToTwips_Err
   
    Dim lngDeviceHandle As Long
    Dim lngPixelsPerInch As Long
    lngDeviceHandle = apiGetDC(0)
    If rlngDirection = DIRECTION_HORIZONTAL Then  '水平X方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
    Else       '垂直Y方向
        lngPixelsPerInch = apiGetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
    End If
    lngDeviceHandle = apiReleaseDC(0, lngDeviceHandle)
    PixelsToTwips = rlngPixels * 1440 / lngPixelsPerInch
   
PixelsToTwips_Exit:
    On Error Resume Next
    Exit Function
   
PixelsToTwips_Err:
    MsgBox Err.Description, vbExclamation, "Access911.Net"
    Resume PixelsToTwips_Exit
   
End Function

'===========================================================
' 過程及函數名：  RunTest
' 版本號      ：  --
' 說明        ：  本過程只用於演示如何用VBA+WINAPI 控制
'                 Access 主窗體的位置和大小
' 引用        ：  --
' 輸入參數    ：  --
' 輸出值      ：  --
' 返回值      ：  --
' 調用演示    ：  RunTest
' 最後修改日期：  2008-1-30 16:36:00
'===========================================================
Function RunTest()
    '顯示當前Access主窗體的高度
    Debug.Print GetAccessWindow.Height
    '設置當前Access窗體：
    '寬 553像素，高400像素，距離上邊20像素，左邊12像素
    SetAccessWindow 12, 20, 553, 400
End Function


'===========================================================
' 過程及函數名：  GetAccessWindow
' 版本號      ：  --
' 說明        ：  獲取 Access 主窗體的大小及位置，獲取單位是
'                 像素，如果要轉為Access的度量衡單位“Twip缇”
'                 可以用函數 PixelsToTwips 轉換。
'                 注意，本函數還定義了一個 Type AWPix
' 引用        ：  --
' 輸入參數    ：  --
' 輸出值      ：  --
' 返回值      ：  返回自定義類型 AWPix 數據。
' 調用演示    ：  Debug.Print GetAccessWindow.Height
' 最後修改日期：  2008-1-30 16:36:00
'===========================================================
Function GetAccessWindow() As AWPix
    Dim intWidth As Long, intHeight As Long
    Dim tAWPix As AWPix
    Dim lngRet As Long
    Dim Rc As RECT
    Dim lngHwndMDI As Long
    '獲取Access主窗體內嵌子對象的句柄
    lngHwndMDI = FindWindowEx(Application.hWndAccessApp, _
        0&, "MDIClIEnt", "")
    '上邊距中不包含工具欄和菜單欄。嘗試去掉工具欄看一下結果，然後再加上工具欄再看看結果
    'lngRet = GetWindowRect(lngHwndMDI, Rc)
   
    '獲取整個Access窗體最外側的尺寸，在Win2003+acc2003的情況下最大化時每邊都需要+4
    lngRet = GetWindowRect(Application.hWndAccessApp, Rc)
   
   
   
    With tAWPix
        .Top = Rc.Top
        .Left = Rc.Left
        .Height = Rc.Bottom - Rc.Top
        .Width = Rc.Right - Rc.Left
    End With
   
    GetAccessWindow = tAWPix
End Function


'===========================================================
' 過程及函數名：  SetAccessWindow
' 版本號      ：  --
' 說明        ：  設置 Access 主窗體的大小及位置，設置單位是像素
' 引用        ：  --
' 輸入參數    ：  --
' 輸出值      ：  --
' 返回值      ：  --
' 調用演示    ：  SetAccessWindow 0,0,150,566
' 最後修改日期：  2008-1-30 16:36:00
'===========================================================
Function SetAccessWindow(ByVal XLeft As Long, _
    ByVal YTop As Long, _
    ByVal XWidth As Long, _
    ByVal YHeight As Long)
   
    Dim lngHwndMDI As Long
    Dim lngRet As Long
    Dim Rc As RECT
    If IsZoomed(Application.hWndAccessApp) = 1 Or _
        IsIconic(Application.hWndAccessApp) = 1 Then
        apiShowWindow Application.hWndAccessApp, SW_SHOWNORMAL
    End If
    MoveWindow Application.hWndAccessApp, XLeft, YTop, XWidth, YHeight, True
End Function