Last Updated 28 Jan 2022                                                 Difficulty level: Moderate

Access provides a built in 'Center Form' as part of the form property sheet. However this only centres the form in a horizontal direction. The outcomes at times can also be visibly well off-centre.

Over the years, I have acquired / written various code samples that can be used to centre forms in both horizontal and vertical directions.

However, I have found that these do not all give identical results. The outcomes depend on whether:
a) Access is maximised or not (occupies part of the screen only)
b) the navigation pane is maximised/minimised or hidden
c) the forms are popup or not

This article includes two example applications which can be used to compare the results and, from that, determine the code that appears to work best

Each application contains 4 identical forms (apart from colour). One uses 4 standard forms, the other has 4 popup forms
Each form is coded so it should open at the centre of the screen (but see below)

Each form is borderless but can be dragged to a new position by holding down the left mouse button on any blank space in the form header. You can then click the Re-centre Form button to run the code used again.

NOTE: Click any screenshot to view a larger image

Standard forms

CentreForm1

Popup forms

CentreForm1Popup

These are the results obtained with Access maximised after clicking the Re-centre form button on each form
In both examples, forms 3 & 4 give identical centre positions.

For standard forms, form 1 & 2 give very different results. Forms 3 & 4 are both placed close to Form 1
For popup forms, results are more consistent. Forms 1 & 2 are identically positioned with forms 3 & 4 only slightly displaced.

Standard forms

CentreForm2MAX

Popup forms

CentreForm2PopupMAX

However, when Access occupies only part of the screen space, results are different again
Once again, in both examples, forms 3 & 4 give identical centre positions.

For standard forms, form 1 & 2 give very different results with form 2 appearing most central.
Forms 3 & 4 are both shifted well to the bottom right, ignoring the actual size of the Access screen
For popup forms, Forms 1 & 2 are both shifted well to the top left. Forms 3 & 4 appear to be centred correctly!

Standard forms

CentreForm3Restore

Popup forms

CentreForm3Restore

Conclusions:
Unfortunately none of the forms give the correct position in all situations

Based on my tests:
For standard forms, form 2 appears to give good results whether or not the form is maximised.
For popup forms, any form is acceptable when the screen is maximised. Forms 3 and 4 are central when only part of the screen is used.


Downloads:

Click to Download:

      Centre Form Examples - v1 - Not Popup    (Approx 0.8 MB zipped)

      Centre Form Examples - v2 - Popup    (Approx 0.8 MB zipped)



Code:
Below is all the code for each form to make it easier to use whichever code you prefer.


Code for Form 1:

Private Sub cmdCentre_Click()
   CenterMe Me
End Sub

Private Sub Form_Load()
   CenterMe Me
End Sub



Module code - CenterMe (in modCentreForm):

Option Compare Database
Option Explicit

#If VBA7 Then
   Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
   Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
   Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
   Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWndPtr As LongPtr, ByVal hDC As LongPtr) As Long
   Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
   Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
   Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
   Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
   Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If

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

Public Const WU_LOGPIXELSX = 88
Public Const WU_LOGPIXELSY = 90

Public Function TwipsPerPixel(strDirection As String) As Long
'Purpose  : Get monitor's Twips per pixel
   'Handle to device
   #If VBA7 Then
       Dim lngDC                       As LongPtr
   #Else
       Dim lngDC                       As Long
   #End If

   Dim lngPixelsPerInch            As Long
   Const nTwipsPerInch = 1440

   lngDC = GetDC(0)

   If strDirection = "X" Then                 'Horizontal
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
   Else                                                         'Vertical
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End If

   lngDC = ReleaseDC(0, lngDC)
   TwipsPerPixel = nTwipsPerInch / lngPixelsPerInch

End Function

Public Sub WindowSize(ByRef Height As Long, ByRef Width As Long)
'Purpose  : Get Access window size.

   #If VBA7 Then
       Dim hWnd                        As LongPtr
   #Else
       Dim hWnd                        As Long
   #End If

   Dim rct                         As RECT

    'use project name in line below
   hWnd = FindWindow(vbNullString, "CentreFormExamples")
   If hWnd <> 0 And GetWindowRect(hWnd, rct) <> 0 Then
       Height = (rct.Bottom - rct.Top) * TwipsPerPixel("Y")
       Width = (rct.Right - rct.Left) * TwipsPerPixel("X")
   End If

End Sub

Public Function CenterMe(frm As Form)
'Purpose  : Center form on screen.
'Requires :
'   Code
'       TwipsPerPixel()
'       WindowSize()
'       Type RECT
'   API Libraries
'       FindWindow
'       GetWindowRect
'       GetDC
'       ReleaseDC
'       GetDeviceCaps
   Dim lngWinWidth As Long
   Dim lngWinHeight As Long
   Dim lngFrmWidth As Long
   Dim lngFrmHeight As Long

   Call WindowSize(lngWinHeight, lngWinWidth)
   frm.SetFocus

   DoCmd.MoveSize (lngWinWidth - frm.WindowWidth) \ 2, _
                (lngWinHeight - frm.WindowHeight) \ 2

End Function




Code for Form 2:

Private Sub cmdCentre_Click()
   Form_Load
End Sub

Private Sub Form_Load()
   Dim fw As New clFormWindow

   fw.hWnd = Me.hWnd
   With fw
       .Top = (.Parent.Height - .Height) / 2
       .Left = (.Parent.Width - .Width) / 2
   End With
   Set fw = Nothing
End Sub



Module code (based on new instance of class module clFormWindow)


Option Compare Database
Option Explicit

'*************************************************************
' Class module: clFormWindow                                
'*************************************************************
' Moves and resizes a window in the coordinate system        
' of its parent window.                                      
' N.B.: This class was developed for use on Access forms    
'       and has not been tested for use with other window types.
'*************************************************************

'*************************************************************
' Type declarations
'*************************************************************
Private Type RECT       'RECT structure used for API calls.
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type POINTAPI   'POINTAPI structure used for API calls.
   X As Long
   Y As Long
End Type

'*************************************************************
' Member variables
'*************************************************************
Private m_hWnd As Long           'Handle of the window.
Private m_rctWindow As RECT     'Rectangle describing the sides of the last polled location of the window.

'*************************************************************
' Private error constants for use with RaiseError procedure
'*************************************************************
Private Const m_ERR_INVALIDHWND = 1
Private Const m_ERR_NOPARENTWINDOW = 2

'*************************************************************
' API function declarations
'*************************************************************
#If VBA7 Then
   Private Declare PtrSafe Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As LongPtr) As Long

   Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (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 Long
       'Moves and resizes a window in the coordinate system of its parent window.

   Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWndPtr As Long, lpRect As RECT) As Long
       'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates.

   Private Declare PtrSafe Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long
       'Converts lpPoint from screen coordinates to the coordinate system of the specified client window.

   Private Declare PtrSafe Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As LongPtr) As Long
       'Returns the handle of the parent window of the specified window.

#Else
   Private Declare Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long
   Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (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
       'Moves and resizes a window in the coordinate system of its parent window.

   Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT) As Long
       'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates.

   Private Declare Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
       'Converts lpPoint from screen coordinates to the coordinate system of the specified client window.

   Private Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As Long) As Long
       'Returns the handle of the parent window of the specified window.
#End If

'*************************************************************
' Private procedures
'*************************************************************
Private Sub RaiseError(ByVal lngErrNumber As Long, ByVal strErrDesc As String)
'Raises a user-defined error to the calling procedure.

   Err.Raise vbObjectError + lngErrNumber, "clFormWindow", strErrDesc

End Sub

Private Sub UpdateWindowRect()
'Places the current window rectangle position (in pixels, in coordinate system of parent window) in m_rctWindow.

   Dim ptCorner As POINTAPI

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       apiGetWindowRect m_hWnd, m_rctWindow   'm_rctWindow now holds window coordinates in screen coordinates.

       If Not Me.Parent Is Nothing Then
           'If there is a parent window, convert top, left of window from screen coordinates to parent window coordinates.
           With ptCorner
               .X = m_rctWindow.Left
               .Y = m_rctWindow.Top
           End With

           apiScreenToClient Me.Parent.hWnd, ptCorner

           With m_rctWindow
               .Left = ptCorner.X
               .Top = ptCorner.Y
           End With

           'If there is a parent window, convert bottom, right of window from screen coordinates to parent window coordinates.
           With ptCorner
               .X = m_rctWindow.Right
               .Y = m_rctWindow.Bottom
           End With

           apiScreenToClient Me.Parent.hWnd, ptCorner

           With m_rctWindow
               .Right = ptCorner.X
               .Bottom = ptCorner.Y
           End With
       End If
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Sub

'*************************************************************
' Public read-write properties
'*************************************************************
Public Property Get hWnd() As Long
'Returns the value the user has specified for the window's handle.

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       hWnd = m_hWnd
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property

Public Property Let hWnd(ByVal lngNewValue As Long)
'Sets the window to use by specifying its handle.
'Only accepts valid window handles.

   If lngNewValue = 0 Or apiIsWindow(lngNewValue) Then
       m_hWnd = lngNewValue
   Else
       RaiseError m_ERR_INVALIDHWND, "The value passed to the hWnd property is not a valid window handle."
   End If

End Property
'----------------------------------------------------

Public Property Get Left() As Long
'Returns the current position (in pixels) of the left edge of the window in the coordinate system of its parent window.

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       Left = m_rctWindow.Left
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Let Left(ByVal lngNewValue As Long)
'Moves the window such that its left edge falls at the position indicated
'(measured in pixels, in the coordinate system of its parent window).

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           apiMoveWindow m_hWnd, lngNewValue, .Top, .Right - .Left, .Bottom - .Top, True
       End With
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Get Top() As Long
'Returns the current position (in pixels) of the top edge of the window in the coordinate system of its parent window.

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       Top = m_rctWindow.Top
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If
End Property
'----------------------------------------------------

Public Property Let Top(ByVal lngNewValue As Long)
'Moves the window such that its top edge falls at the position indicated
'(measured in pixels, in the coordinate system of its parent window).

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           apiMoveWindow m_hWnd, .Left, lngNewValue, .Right - .Left, .Bottom - .Top, True
       End With
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Get Width() As Long
'Returns the current width (in pixels) of the window.

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           Width = .Right - .Left
       End With
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Let Width(ByVal lngNewValue As Long)
'Changes the width of the window to the value provided (in pixels).

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           apiMoveWindow m_hWnd, .Left, .Top, lngNewValue, .Bottom - .Top, True
       End With
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Get Height() As Long
'Returns the current height (in pixels) of the window.
   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           Height = .Bottom - .Top
       End With
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property
'----------------------------------------------------

Public Property Let Height(ByVal lngNewValue As Long)
'Changes the height of the window to the value provided (in pixels).

   If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then
       UpdateWindowRect
       With m_rctWindow
           apiMoveWindow m_hWnd, .Left, .Top, .Right - .Left, lngNewValue, True
       End With
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

End Property

'*************************************************************
' Public read-only properties
'*************************************************************
Public Property Get Parent() As clFormWindow
'Returns the parent window as a clFormWindow object.
'For forms, this should be the Access MDI window.

   Dim fwParent As New clFormWindow
   Dim lngHWnd As Long
   If m_hWnd = 0 Then
       Set Parent = Nothing
   ElseIf apiIsWindow(m_hWnd) Then
       lngHWnd = apiGetParent(m_hWnd)
       fwParent.hWnd = lngHWnd
       Set Parent = fwParent
   Else
       RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid."
   End If

   Set fwParent = Nothing

End Property




Code for Form 3:

Private Sub cmdCentre_Click()
   CentreForm Me
End Sub

Private Sub Form_Load()
   CentreForm Me
End Sub



Module code (CentreForm procedure in module modFormInfo)

Option Compare Database
Option Explicit

'===============================================
'Colin Riddington - Mendip Data Systems - 18/02/2019
'Functions to get form dimensions and to reset to default size
'===============================================

Public intWindowLeft As Integer
Public intWindowTop As Integer

Public intInsideHeight As Integer
Public intInsideWidth As Integer

Public intWindowHeight As Integer
Public intWindowWidth As Integer
Public intTotalFormHeight As Integer
Public intTotalFormWidth As Integer
Public intHeightHeader As Integer
Public intHeightDetail As Integer
Public intHeightFooter As Integer
' Public intFormControlBarHeight As Integer
' Public intFormControlBarWidth As Integer
Public intTitleBarHeight As Integer
Public intNavBarHeight As Integer
Public intRecSelWidth As Integer
Public intScrollBarWidth As Integer
Public intScrollBarHeight As Integer
Public frm As Access.Form
Public intBorderWidth As Integer
Public intBorderHeight As Integer

Public intBorderStyle As Integer
Public intScrollbars As Integer

Sub CentreForm(frm As Form)

On Error GoTo Err_Handler

   ' Determine form's height.
   intHeightHeader = frm.Section(acHeader).Height
   intHeightDetail = frm.Section(acDetail).Height
   intHeightFooter = frm.Section(acFooter).Height
   intTotalFormHeight = intHeightHeader + intHeightDetail + intHeightFooter

   ' Determine form's width.
   intTotalFormWidth = frm.Width

   'Centre the form on screen
   DoCmd.MoveSize (MetricsScreenWidth - intTotalFormWidth) / 2, (MetricsScreenHeight - intTotalFormHeight) / 2 ', intTotalFormWidth, intTotalFormHeight

Exit_Handler:
  Exit Sub

Err_Handler:
  MsgBox "Error " & Err.Number & " in ResetWindowSize procedure : " & Err.description
  Resume Exit_Handler

End Sub
'--------------------------------------------------------

Function GetFormDimensions(frm As Form)

On Error GoTo Err_Handler

   'form position
   intWindowLeft = frm.WindowLeft
   intWindowTop = frm.WindowTop

   'form external size
   intTotalFormHeight = frm.WindowHeight
   intTotalFormWidth = frm.WindowWidth

   'form internal size
   intInsideHeight = frm.InsideHeight
   intInsideWidth = frm.InsideWidth

  'section heights
   intHeightHeader = frm.Section(acHeader).Height
   intHeightDetail = frm.Section(acDetail).Height
   intHeightFooter = frm.Section(acFooter).Height
   '------------------------------------------------

   'get border & title bar height
   Select Case frm.BorderStyle

   Case 0 'none
        intTitleBarHeight = 0
        intBorderHeight = 45
   Case 1 'thin
        intBorderHeight = 45
        intTitleBarHeight = 390 '345 title bar + 45 top border
   Case 2 'sizable
       intBorderHeight = 150
       intTitleBarHeight = 495 '345 title bar + 150 top border
   Case 3 ' dialog
       intBorderHeight = 45
       intTitleBarHeight = 390 '345 title bar + 45 top border
   End Select
   intBorderWidth = intBorderHeight
    '------------------------------------------------

   'get scrollbar sizes
   Select Case frm.ScrollBars
   
   Case 0 'none
        intScrollBarHeight = 0
        intScrollBarWidth = 0
   Case 1 'horiz only
        intScrollBarWidth = 0
        intScrollBarHeight = 255
   Case 2 'vert only
        intScrollBarWidth = 255
        intScrollBarHeight = 0
   Case 3 ' dialog
        intScrollBarWidth = 255
        intScrollBarHeight = 255
   End Select

   'If nav buttons visible, horiz scrollbar shares space with nav button bar
   If frm.NavigationButtons = True Then
       intNavBarHeight = 285
       intScrollBarHeight = 0
   Else
       intNavBarHeight = 0
   End If

   '------------------------------------------------
   If frm.RecordSelectors = True Then
       intRecSelWidth = 255
  Else
       intRecSelWidth = 0
  End If

Exit_Handler:
  Exit Function

Err_Handler:
  ' If Err = 5 Then Resume Next
  MsgBox "Error " & Err.Number & " in GetFormDimensions procedure : " & Err.description
  Resume Exit_Handler

End Function
'--------------------------------------------------------

Sub ResetWindowSize(frm As Form)

On Error GoTo Err_Handler

   ' Determine form's height.
   intHeightHeader = frm.Section(acHeader).Height
   intHeightDetail = frm.Section(acDetail).Height
   intHeightFooter = frm.Section(acFooter).Height
   intTotalFormHeight = intHeightHeader + intHeightDetail + intHeightFooter

   ' Determine form's width.
   intTotalFormWidth = frm.Width

   ' Determine window's height and width.
   intWindowHeight = frm.InsideHeight
   intWindowWidth = frm.InsideWidth

   'reset to fit intended size
   If intWindowWidth <> intTotalFormWidth Then
      frm.InsideWidth = intTotalFormWidth
   End If

   If intWindowHeight <> intTotalFormHeight Then
      frm.InsideHeight = intTotalFormHeight
   End If

Exit_Handler:
  Exit Sub

Err_Handler:
  MsgBox "Error " & Err.Number & " in ResetWindowSize procedure : " & Err.description
  Resume Exit_Handler

End Sub




Code for Form 4:

Private Sub cmdCentre_Click()
   CenterForm Me
End Sub

Private Sub Form_Load()
   CenterForm Me
End Sub



Module Code - based on CenterForm procedure in module modFormCentre

' (c) Renaud Bompuis, 2008
' Licensed under the Creative Commons Attribution License
' http://creativecommons.org/licenses/by/3.0/
' http://creativecommons.org/licenses/by/3.0/legalcode

' Free for re-use in any application or tutorial providing clear credit
' is made about the origin of the code and a link to the site above
' is prominently displayed where end-user can access it.

' updated for 64bit
'-----------------------------------------------------------------------------
Option Compare Database
Option Explicit

Private Type RECT
   X1 As Long
   Y1 As Long
   X2 As Long
   Y2 As Long
End Type

#If VBA7 Then
   Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
   Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
   Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
   Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
   Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
   Private Declare Function GetDesktopWindow Lib "user32" () As Long
   Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rectangle As RECT) As Boolean
   Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
   Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
   Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If

Private Const WU_LOGPIXELSX = 88
Private Const WU_LOGPIXELSY = 90

Sub CenterForm(f As Form)
   Dim formWidth As Long, formHeight As Long
   Dim maxWidth As Long, maxHeight As Long
   Dim ScreenWidth As Long, ScreenHeight As Long
   Dim formAllMarginsHeight As Long, formAllMarginsWidth As Long

   ' Compute maximal acceptable dialog box size in twips
   GetScreenResolution ScreenWidth, ScreenHeight
   ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0)
   ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0)
   maxWidth = ScreenWidth * 0.6
   maxHeight = ScreenHeight * 0.9

   ' Calculate the height and width of the area around the textbox
   formAllMarginsHeight = f.WindowHeight - f.Section(acDetail).Height
   formAllMarginsWidth = f.Width

   ' Assess proper width and height of the overall dialog box
   formWidth = formAllMarginsWidth
   formHeight = formAllMarginsHeight

   ' Adjust position of the the box to the middle if there is not much text.
   If formHeight < f.WindowHeight Then
       formHeight = f.WindowHeight
   End If

   ' Redimension the dialog and display the message at the center of the screen
   DoCmd.MoveSize (ScreenWidth - formWidth) / 2, (ScreenHeight - formHeight) / 2, formWidth, formHeight

End Sub

'-----------------------------------------------------------------------------
' Pixel to Twips conversions
'-----------------------------------------------------------------------------
' cf http://support.microsoft.com/default.aspx?scid=kb;en-us;210590
' To call this function, pass the number of twips you want to convert,
' and another parameter indicating the horizontal or vertical measurement
' (0 for horizontal, non-zero for vertical). The following is a sample call:

Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
'Handle to device
   Dim lngPixelsPerInch As Long
   Const nTwipsPerInch = 1440

#If Win64 Then
   Dim lngDC As LongPtr
#Else
   Dim lngDC As Long
#End If

   lngDC = GetDC(0)
   If (lngDirection = 0) Then       'Horizontal
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
   Else                            'Vertical
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End If
   lngDC = ReleaseDC(0, lngDC)
   ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function
'-------------------------------------------------------------

Function ConvertPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long
'Handle to device
   Dim lngPixelsPerInch As Long
   Const nTwipsPerInch = 1440

#If Win64 Then
   Dim lngDC As LongPtr
#Else
   Dim lngDC As Long
#End If

   lngDC = GetDC(0)

   If (lngDirection = 0) Then       'Horizontal
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
   Else                            'Vertical
       lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
   End If

   lngDC = ReleaseDC(0, lngDC)
   ConvertPixelsToTwips = (lngPixels * nTwipsPerInch) / lngPixelsPerInch
'-------------------------------------------------------------

End Function

Private Sub GetScreenResolution(ByRef Width As Long, ByRef Height As Long)
   Dim r As RECT
   Dim RetVal As Long

#If Win64 Then
   Dim hWnd As LongPtr
#Else
   Dim hWnd As Long
#End If

   hWnd = GetDesktopWindow()
   RetVal = GetWindowRect(hWnd, r)
   Width = r.X2 - r.X1
   Height = r.Y2 - r.Y1

End Sub






Return to Access Articles Page                                                           Return to Top