เรื่องโหมดหน้าจอเป็นปัญหาที่เจอกันบ่อยจนชินครับ ไม่ใช่แค่โหมดหน้าจอ เรื่องอัตราส่วนอีก สมัยกัน 4:3 เป็น 16:9 และอื่นๆอีก

หลักการผมคือพยายเขียนหน้าจอโหมด VGA ไว้ก่อน คือขนาดเล็กสุดที่ทุกวันนี้ยังพอมีคนใช้อยู่ แล้วก็กำหนด Anchor ให้ชิดซ้าย หรือขวา บนหรือล่าง หรือแบบขยายตามหน้าจอฟอร์ม ก็จะพอใช้ได้กับหน้าจอที่ใหญ่กว่าที่เราออกแบบไว้

แต่สำหรับคุณออกแบบหน้าจอใหญ่อยากใช้กับหน้าจอที่เล็กกว่าอันนี้ ผมเคยเห็นเค้าใช้ฟังก์ชั่นนี้กัน ผมก็ไม่รู้ว่าใช้ได้ดีแค่ไหน ลองดูแล้วกันนะครับ

- ใส่โค๊ดลงใน Module

' กำหนดขนาดฟอร์มต้นฉบับที่ทำการออกแบบไว้ เช่น หากเราออกแบบฟอร์มในเครื่องที่ใช้โหมด กว้าง 1366 สูง 768 dpi 96 ก็ต้องใส่ค่าในตัวแปรให้ตรง
Private Const DESIGN_HORZRES As Long = 1366
Private Const DESIGN_VERTRES As Long = 768
Private Const DESIGN_PIXELS As Long = 96
'--------------------------------------------------------------------------------------------------------------------------
Private Const WM_HORZRES As Long = 8
Private Const WM_VERTRES As Long = 10
Private Const WM_LOGPIXELSX As Long = 88
Private Const TITLEBAR_PIXELS As Long = 18
Private Const COMMANDBAR_PIXELS As Long = 26
Private Const COMMANDBAR_LEFT As Long = 0
Private Const COMMANDBAR_TOP As Long = 1
Private OrigWindow As tWindow

Private Type tRect
    left As Long
    Top As Long
    right As Long
    bottom As Long
End Type

Private Type tDisplay
    Height As Long
    Width As Long
    DPI As Long
End Type

Private Type tWindow
    Height As Long
    Width As Long
End Type

Private Type tControl
    Name As String
    Height As Long
    Width As Long
    Top As Long
    left As Long
End Type

Private Declare PtrSafe Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long

Private Declare PtrSafe Function WM_apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long

Private Declare PtrSafe Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hdc As Long) As Long

Private Declare PtrSafe Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _
(ByVal hWnd As Long, lpRect As tRect) As Long

Private Declare PtrSafe Function WM_apiMoveWindow Lib "user32.dll" 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

Private Declare PtrSafe Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" (ByVal hWnd As Long) As Long

Private Function getScreenResolution() As tDisplay
    Dim hDCcaps As Long
    Dim lngRtn As Long
On Error Resume Next
    'API call get current resolution:-
    hDCcaps = WM_apiGetDC(0) 'Get display context for desktop (hwnd = 0).
    With getScreenResolution
        .Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
        .Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
        .DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX)
    End With
    lngRtn = WM_apiReleaseDC(0, hDCcaps) 'Release display context.    
End Function

Private Function getFactor(blnVert As Boolean) As Single
    Dim sngFactorP As Single
On Error Resume Next
    If getScreenResolution.DPI <> 0 Then
        sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI
    Else
        sngFactorP = 1 'Error with dpi reported so assume 96 dpi.
    End If
    If blnVert Then 'return vertical resolution.
        getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP
    Else 'return horizontal resolution.
        getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP
    End If
End Function

Public Sub ReSizeForm(ByVal frm As Access.Form)
    Dim rectWindow As tRect
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim sngVertFactor As Single
    Dim sngHorzFactor As Single
    Dim sngFontFactor As Single
On Error Resume Next
    sngVertFactor = getFactor(True)
    sngHorzFactor = getFactor(False)
    sngFontFactor = VBA.IIf(sngHorzFactor < sngVertFactor, sngHorzFactor, sngVertFactor)
    Resize sngVertFactor, sngHorzFactor, sngFontFactor, frm 'Local procedure to resize form sections & controls.
    If WM_apiIsZoomed(frm.hWnd) = 0 Then
        Access.DoCmd.RunCommand acCmdAppMaximize 'Maximize the Access Window.

        Call WM_apiGetWindowRect(frm.hWnd, rectWindow)

        With rectWindow
            lngWidth = .right - .left
            lngHeight = .bottom - .Top
        End With

        If frm.Parent.Name = VBA.vbNullString Then
            Call WM_apiMoveWindow(frm.hWnd, ((getScreenResolution.Width - _
            (sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _
            ((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _
            getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1)
        End If
    End If
    Set frm = Nothing 'Free up resources.
End Sub

Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, sngFontFactor As _
Single, ByVal frm As Access.Form)
    Dim ctl As Access.Control            'Form control variable.
    Dim arrCtls() As tControl            'Array of Tab and Option Group control properties.
    Dim lngI As Long                     'Loop counter.
    Dim lngJ As Long                     'Loop counter.
    Dim lngWidth As Long                 'Stores form's new width.
    Dim lngHeaderHeight As Long          'Stores header's new height.
    Dim lngDetailHeight As Long          'Stores detail's new height.
    Dim lngFooterHeight As Long          'Stores footer's new height.
    Dim blnHeaderVisible As Boolean      'True if form header visible before resize.
    Dim blnDetailVisible As Boolean      'True if form detail visible before resize.
    Dim blnFooterVisible As Boolean      'True if form footer visible before resize.
    Const FORM_MAX As Long = 31680       'Maximum possible form width & section height.
On Error Resume Next    
    With frm
        .Painting = False
        lngWidth = .Width * sngHorzFactor
        lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor
        lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor
        lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor
        .Width = FORM_MAX
        .Section(Access.acHeader).Height = FORM_MAX
        .Section(Access.acDetail).Height = FORM_MAX
        .Section(Access.acFooter).Height = FORM_MAX
        blnHeaderVisible = .Section(Access.acHeader).Visible
        blnDetailVisible = .Section(Access.acDetail).Visible
        blnFooterVisible = .Section(Access.acFooter).Visible
        .Section(Access.acHeader).Visible = False
        .Section(Access.acDetail).Visible = False
        .Section(Access.acFooter).Visible = False
    End With

    ReDim arrCtls(0)
    For Each ctl In frm.Controls
        If ((ctl.ControlType = Access.acTabCtl) Or _
        (ctl.ControlType = Access.acOptionGroup)) Then
            With arrCtls(lngI)
               .Name = ctl.Name
               .Height = ctl.Height
               .Width = ctl.Width
               .Top = ctl.Top
               .left = ctl.left
            End With
            lngI = lngI + 1
            ReDim Preserve arrCtls(lngI) 'Increase the size of the array.
        End If
    Next ctl

    For Each ctl In frm.Controls
        If ctl.ControlType <> Access.acPage Then 'Ignore pages in Tab controls.
            With ctl
               .Height = .Height * sngVertFactor
               .left = .left * sngHorzFactor
               .Top = .Top * sngVertFactor
               .Width = .Width * sngHorzFactor
               .FontSize = .FontSize * sngFontFactor
               Select Case .ControlType
                    Case Access.acListBox
                        .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
                    Case Access.acComboBox
                        .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor)
                        .ListWidth = .ListWidth * sngHorzFactor
                    Case Access.acTabCtl
                        .TabFixedWidth = .TabFixedWidth * sngHorzFactor
                        .TabFixedHeight = .TabFixedHeight * sngVertFactor
               End Select
            End With
        End If
    Next ctl
    For lngJ = 0 To lngI
        With frm.Controls.Item(arrCtls(lngJ).Name)
            .left = arrCtls(lngJ).left * sngHorzFactor
            .Top = arrCtls(lngJ).Top * sngVertFactor
            .Height = arrCtls(lngJ).Height * sngVertFactor
            .Width = arrCtls(lngJ).Width * sngHorzFactor
        End With
    Next lngJ

    With frm
        .Width = lngWidth
        .Section(Access.acHeader).Height = lngHeaderHeight
        .Section(Access.acDetail).Height = lngDetailHeight
        .Section(Access.acFooter).Height = lngFooterHeight
        .Section(Access.acHeader).Visible = blnHeaderVisible
        .Section(Access.acDetail).Visible = blnDetailVisible
        .Section(Access.acFooter).Visible = blnFooterVisible
        .Painting = True 'Turn form painting on.
    End With
    Erase arrCtls
    Set ctl = Nothing 'Free up resources.
End Sub

Private Function getTopOffset() As Long
    Dim cmdBar As Object
    Dim lngI As Long
On Error GoTo err
     For Each cmdBar In Application.CommandBars
        If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then
            lngI = lngI + 1
        End If
     Next cmdBar
     getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS))

exit_fun:
    Exit Function    
err:
    getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS
    Resume exit_fun
End Function

Private Function getLeftOffset() As Long
    Dim cmdBar As Object
    Dim lngI As Long
On Error GoTo err
     For Each cmdBar In Application.CommandBars
        If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then
            lngI = lngI + 1
        End If
     Next cmdBar
     getLeftOffset = (lngI * COMMANDBAR_PIXELS)

exit_fun:
    Exit Function
    
err:
    getLeftOffset = 0
    Resume exit_fun     
End Function

Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) As String
On Error GoTo Err_adjustColumnWidths
    Dim astrColumnWidths() As String
    Dim strTemp As String
    Dim lngI As Long
    Dim lngJ As Long
    ReDim astrColumnWidths(0)
    For lngI = 1 To VBA.Len(strColumnWidths)
        Select Case VBA.Mid(strColumnWidths, lngI, 1)
            Case Is <> ";"
               astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _
               strColumnWidths, lngI, 1)
            Case ";"
               lngJ = lngJ + 1
               ReDim Preserve astrColumnWidths(lngJ) 'Resize the array.
        End Select
    Next lngI
    lngI = 0
    strTemp = VBA.vbNullString 'Sets the temp variable to a null string
    Do Until lngI > UBound(astrColumnWidths)
        If Not IsNull(astrColumnWidths(lngI)) And astrColumnWidths(lngI) <> "" Then
            strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";"
        End If
        lngI = lngI + 1
    Loop
    adjustColumnWidths = strTemp
    Erase astrColumnWidths
    
Exit_adjustColumnWidths:
    On Error Resume Next
    Exit Function

Err_adjustColumnWidths:
    Erase astrColumnWidths
    Resume Exit_adjustColumnWidths    
End Function

Public Sub getOrigWindow(frm As Access.Form)
On Error Resume Next
    OrigWindow.Height = frm.WindowHeight
    OrigWindow.Width = frm.WindowWidth
End Sub

Public Sub RestoreWindow()
On Error Resume Next
    Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height
    Access.DoCmd.Save    
End Sub



- บนฟอร์ม ที่ Event > On Load หรือ On Open แล้วแต่ความเหมาะสม
'----------------Start Code----------------
Call ResizeForm(Me)
DoCmd.Maximize
'-----------------End Code-----------------
- หากฟอร์มมีซับฟอร์มและซับฟอร์มก็มีซับฟอร์มอีก
'----------------Start Code----------------
Call ResizeForm(Me)
Call ResizeForm(Forms!ชื่อฟอร์ม.ชื่อซับฟอร์ม.Form)
Call ReSizeForm(Forms!ชื่อฟอร์ม.ชื่อซับฟอร์ม.Form.ชื่อซับฟอร์มของซับฟอร์ม.Form)
'-----------------End Code-----------------

* หากใช้กับ MS Access 2007 ขึ้นไป ต้องกำหนด Options > Current Database > Overlapping Windows หากเป็น Tabbed Documents จะใช้ไม่ได้

ผมเองแค่เคยทดสอบดู ก็ใช้ได้ดีประมาณนึงครับ หวังว่าคงจะเป็นประโยชน์