Changing screen resolution in Excel by VBA?

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • Sickbock
    New Member
    • Oct 2013
    • 3

    #1

    Changing screen resolution in Excel by VBA?

    I have a computer that can manually be switched to 2 monitors. Both monitors do not have the same screen resolution. I am running a macro controlled presentation in Excel 2010 and I want to change the screen resolution when switching to the other monitor. In a previous post, “Change Screen Resolution using VB”, I found the following solution:

    Code:
    '************************************************* ****************
    ' DECLARATIONS SECTION
    '************************************************* ****************
    
    Option Compare Database
    Option Explicit
    
    Type RECT
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
    End Type
    
    ' NOTE: The following declare statements are case sensitive.
    
    Declare Function GetDesktopWindow Lib "User32" () As Long
    Declare Function GetWindowRect Lib "User32" _
    (ByVal hWnd As Long, rectangle As RECT) As Long
    '================================================= =====
    
    'This code shows how to change the screen resolution.
    
    'Call the function like this:
    
    ' ChangeResolution 640, 480
    
    'This would change the screen resolution to 640 pixels x 480 pixels. Note
    that
    'you can only change the resolution to values supported by the display.
    
    'Paste the following code into a module:'
    
    Private Declare Function ChangeDisplaySettings Lib "User32" Alias _
    "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
    Private Declare Function EnumDisplaySettings Lib "User32" Alias _
    "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As _
    Long, lpDevMode As Any) As Boolean
    
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const CCFORMNAME = 32
    Const CCDEVICENAME = 32
    
    Private 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 Function Change_Resolution(iWidth As Single, iHeight As Single)
    
    Dim DevM As DEVMODE
    Dim a As Boolean
    Dim i As Long
    Dim b As Long
    
    i = 0
    
    'Enumerate settings
    Do
    a = EnumDisplaySettings(0&, i&, DevM)
    i = i + 1
    Loop Until (a = False)
    
    'Change settings
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    
    DevM.dmPelsWidth = iWidth
    DevM.dmPelsHeight = iHeight
    
    b = ChangeDisplaySettings(DevM, 0)
    
    End Function
    
    '************************************************* ****************
    ' FUNCTION: GetScreenResolution()
    '
    ' PURPOSE:
    ' To determine the current screen size or resolution.
    '
    ' RETURN:
    ' The current screen resolution. Typically one of the following:
    ' 640 x 480
    ' 800 x 600
    ' 1024 x 768
    '
    '************************************************* ****************
    Function GetScreenResolution() As String
    
    Dim R As RECT
    Dim hWnd As Long
    Dim RetVal As Long
    
    hWnd = GetDesktopWindow()
    RetVal = GetWindowRect(hWnd, R)
    GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
    
    End Function
    I pasted the code to a module from a workbook but this does not function. Does anybody know what I am doing wrong an how to achieve my goal: Changing screen resolution in Excel by VBA?
    Last edited by Rabbit; Oct 4 '13, 05:58 PM. Reason: Please use [CODE] and [/CODE] tags when posting code or formatted data.
  • Rabbit
    Recognized Expert MVP
    • Jan 2007
    • 12517

    #2
    You didn't call your function anywhere.

    Comment

    • Sickbock
      New Member
      • Oct 2013
      • 3

      #3
      Thanks Rabbit for your quick response. This was a little bit stupid indeed. But now I am immediately facing the next problem. When I write a procedure to call the function to change the screen resolution, the automatic fill up function of VBA wants me to add a sign of equality behind the expression "change_resolut ion(1280, 1024)". But I do not know what to add behind the sign of equality. I now put a x behind it, and the screen resolution is changing by running this procedure. Nevertheless I get a failure message at the end:
      "Failure 424 during running: Object necessary"
      What do I need to change in the procedure as shown below to prevent the failure message?

      Code:
      Sub change()
      change_resolution(1280, 1024) = x '????
      End Sub

      Comment

      • Rabbit
        Recognized Expert MVP
        • Jan 2007
        • 12517

        #4
        Subs are called without parentheses. Functions are called with parentheses.

        Comment

        • Sickbock
          New Member
          • Oct 2013
          • 3

          #5
          Thanks Rabbit for your help
          I have changed the code as shown below. This works

          Code:
          Sub change()
          Call change_resolution(1280, 1024)
          End Sub

          Comment

          Working...