First Published 4 Oct 2022


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:

Option Compare Database
Option Explicit

'#################################################
'API to manage resolution
'CR - Checked 05/03/2019
'#################################################

#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 CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const DM_DUPLEX = &H20000
Public Const CDS_TEST = &H4

Public Type DEVMODE
      dmDeviceName As String * CCDEVICENAME
      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 * CCFORMNAME
      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_TEST, 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_TEST, ByVal 0&)

Exit_Handler:
      Exit Sub

Err_Handler:
      MsgBox "Error " & Err.number & " in RestoreResolution procedure : " & Err.description
      Resume Exit_Handler

End Sub

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



Please use the contact form to let me know whether you found this code useful or if you have any questions.



Colin Riddington           Mendip Data Systems                 Last Updated 4 Oct 2022

Return to Code Samples Page

Return to Top