First Published 4 Oct 2022                 Last Updated 12 Sept 2025


UPDATED 12 Sept 2025: Fixed minor errors in names/values of some constsants used in this code. No change to functionality. Thanks to John Mallinson for this information.

The code below provides a simple method of changing the screen resolution from within an Access application

The code includes 3 procedures and will work in both 32-bit and 64-bit Access:
a)   GetDefaultResolution    - this is for the primary monitor
b)   ChangeResolution    - for any connected monitor; the values must be allowed by that monitor
c)   RestoreResolution    - restores the default resolution

NOTE:
The list of allowed resolutions for each monitor is available in Windows Settings . . . Display





Copy ALL the code below to a standard module

CODE:

Copy code
Option Compare Database
Option Explicit

'#################################################
'APIs to manage resolution - Colin Riddington (Mendip Data Systems)
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-changedisplaysettingsexa

'CR 05/03/2019: Re-checked 32/64-bit conversion
'CR 12/09/2025: Minor corrections to names/values of some constants - no change in functionality
'               Thanks due to John Mallinson (VBE_Extras) for this information
'#################################################

#If VBA7 Then
      Public Declare PtrSafe Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
            (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

      Public Declare PtrSafe Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" _
            (lpszDeviceName As Any, lpDevMode As Any, ByVal hwnd As LongPtr, ByVal dwFlags As Long, lParam As Any) As Long
#Else
      Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
            (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

      Public Declare Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" _
            (lpszDeviceName As Any, lpDevMode As Any, ByVal hwnd As Long, ByVal dwFlags As Long, lParam As Any) As Long
#End If

Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const DM_DUPLEX = &H1000&
Public Const CDS_FULLSCREEN = &H4

Public Type DEVMODE
      dmDeviceName As String * CCHDEVICENAME
      dmSpecVersion As Integer
      dmDriverVersion As Integer
      dmSize As Integer
      dmDriverExtra As Integer
      dmFields As Long
      dmOrientation As Integer
      dmPaperSize As Integer
      dmPaperLength As Integer
      dmPaperWidth As Integer
      dmScale As Integer
      dmCopies As Integer
      dmDefaultSource As Integer
      dmPrintQuality As Integer
      dmColor As Integer
      dmDuplex As Integer
      dmYResolution As Integer
      dmTTOption As Integer
      dmCollate As Integer
      dmFormName As String * CCHFORMNAME
      dmUnusedPadding As Integer
      dmBitsPerPel As Integer
      dmPelsWidth As Long
      dmPelsHeight As Long
      dmDisplayFlags As Long
      dmDisplayFrequency As Long
End Type

Public DevM As DEVMODE
Dim HRes As Integer, VRes As Integer
Dim A As Boolean
Dim I&
Dim B&

'-----------------------------------------

Public Sub GetDefaultResolution()

On Error GoTo Err_Handler

      I = 0
      Do
            A = EnumDisplaySettings(0&, I, DevM)
            I = I + 1
      Loop Until (A = False)

      'gets primary monitor resolution
      HRes = DevM.dmPelsWidth     '(Horizontal)
      VRes = DevM.dmPelsHeight     '(Vertical)

     ' Debug.Print HRes, VRes

Exit_Handler:
      Exit Sub

Err_Handler:
      MsgBox "Error " & Err.Number & " in GetDefaultResolution procedure : " & Err.Description
      Resume Exit_Handler

End Sub

'-----------------------------------------

Public Sub ChangeResolution()

On Error GoTo Err_Handler

      I = 0

      Do
            A = EnumDisplaySettings(0&, I, DevM)
            I = I + 1
      Loop Until (A = False)

      With DevM
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
            .dmPelsWidth = 1366     '(Horizontal)
            .dmPelsHeight = 768     '(Vertical)
      End With

      'Change Display Settings for Monitor 1 (change DISPLAY1 for other monitor(s))
      Call ChangeDisplaySettingsEx(ByVal "\\.\DISPLAY1", DevM, ByVal 0&, CDS_FULLSCREEN, ByVal 0&)

Exit_Handler:
      Exit Sub

Err_Handler:
      MsgBox "Error " & Err.Number & " in ChangeResolution procedure : " & Err.Description
      Resume Exit_Handler

End Sub

'-----------------------------------------

Public Sub RestoreResolution()

On Error GoTo Err_Handler

      I = 0

      Do
            A = EnumDisplaySettings(0&, I, DevM)
            I = I + 1
      Loop Until (A = False)

      With DevM
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
            .dmPelsWidth = HRes     '(Horizontal)
            .dmPelsHeight = VRes     '(Vertical)
      End With

      'Change Display Settings for Monitor 1 (change DISPLAY1 for other monitor(s))
      Call ChangeDisplaySettingsEx(ByVal "\\.\DISPLAY1", DevM, ByVal 0&, CDS_FULLSCREEN, ByVal 0&)

Exit_Handler:
      Exit Sub

Err_Handler:
      MsgBox "Error " & Err.Number & " in RestoreResolution procedure : " & Err.Description
      Resume Exit_Handler

End Sub

Download

Alternatively, download & unzip the attached file. You can then import the modChangeRes.bas file directly into the Visual Basic Editor

Click to download:   modChangeRes.zip



Acknowledgements

Thanks to John Mallinson for advising me of minor errors in names/values of some constants used in this code.



Feedback

Please use the contact form below to let me know whether you found this article interesting/useful or if you have any questions/comments.

Please also consider making a donation towards the costs of maintaining this website. Thank you



Colin Riddington           Mendip Data Systems                 Last Updated 12 Sept 2025

Return to Code Samples Page

Return to Top