Results 1 to 7 of 7

Adjusting Screen Resolution Directly At Workbook Startup

Threaded View

  1. #1
    Forum Contributor
    Join Date
    11-07-2005
    Posts
    280

    Adjusting Screen Resolution Directly At Workbook Startup

    Hi everyone,

    I have the following code to check Screen Resolution at workbook startup and change it directly to 1024 X 768 if it is not.

    In addition to that, at workbook startup, I want to save the original Screen Resolution in the memory in order to reset Screen Resolution to it original setting before closing the program.

    For that purpose I made some changes to the code (My changes work perfectly at workbook startup), but before closing the program, I receive a Compile error message says that (ByRef argument type mismatch),

    Here is main code:
    Option Explicit

    Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1
    
    Private Const EWX_REBOOT = 2
    Private Const CCDEVICENAME = 32
    Private Const CCFORMNAME = 32
    Private Const DM_BITSPERPEL = &H40000
    Private Const DM_PELSWIDTH = &H80000
    Private Const DM_PELSHEIGHT = &H100000
    Private Const CDS_UPDATEREGISTRY = &H1
    Private Const CDS_TEST = &H4
    Private Const DISP_CHANGE_SUCCESSFUL = 0
    Private Const DISP_CHANGE_RESTART = 1
    
    
    Private Type typDevMODE
        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
    
    Private Declare Function EnumDisplaySettings Lib _
      "user32" Alias "EnumDisplaySettingsA" _
      (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
      lptypDevMode As Any) As Boolean
    
    Private Declare Function ChangeDisplaySettings Lib _
      "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, _
      ByVal dwFlags As Long) As Long
      
    Private Declare Function ExitWindowsEx Lib _
      "user32" (ByVal uFlags As Long, _
      ByVal dwReserved As Long) As Long
    
    
    Public Function ChangeDisplayResolution(NewWidth As Long, _
       NewHeight As Long) As Boolean
    
    'Usage:  ChangeDisplayResolution 800, 600
    
    'Returns: True if succesful, false otherwise
    
    'Comments:  Problems have been reported using this code for
    'resolutions higher than 1024 X 768.  We recommend not using this
    'snippet to go above this limit.
    
    
    Dim typDM As typDevMODE
    Dim lRet As Long
    Dim iResp  As Integer
    
    'typDM = pointer to info about current
    'display settings
    
    lRet = EnumDisplaySettings(0, 0, typDM)
    If lRet = 0 Then Exit Function
    
    ' Set the new resolution.
    With typDM
        .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        .dmPelsWidth = NewWidth
        .dmPelsHeight = NewHeight
    End With
    
    'Do the update -- Pass update structure to
    'ChangeDisplaySettings API function
    lRet = ChangeDisplaySettings(typDM, CDS_UPDATEREGISTRY)
    Select Case lRet
    Case DISP_CHANGE_RESTART
    
       iResp = MsgBox _
      ("You must restart your computer to apply these changes." & _
            vbCrLf & vbCrLf & "Restart now?", _
            vbYesNo + vbInformation, "Screen Resolution Changed")
        If iResp = vbYes Then
            ChangeDisplayResolution = True
            Reboot
        End If
    
    Case DISP_CHANGE_SUCCESSFUL
        ChangeDisplayResolution = True
    Case Else
        ChangeDisplayResolution = False
    End Select
    
    End Function
    
    Private Sub Reboot()
        Dim lRet As Long
        lRet = ExitWindowsEx(EWX_REBOOT, 0)
    End Sub

    Sub VerifyScreenResolution(Optional Dummy As Integer)
         
        Dim x, y, MyA, MyB As Long
         
        x = GetSystemMetrics(SM_CXSCREEN)
        y = GetSystemMetrics(SM_CYSCREEN)
        MyA = x
        MyB = y
        If x = 1024 And y = 768 Then
        Else
        ChangeDisplayResolution 1024, 768
        End If
    End Sub
    And here is Workbook Open and Before Closing codes:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Dim MyA, MyB As Long
    
    If MyA = "" And MyB = "" Then
    Exit Sub
    Else:
    ChangeDisplayResolution MyA, MyB
    End
    End If
    
    End Sub
    Private Sub Workbook_Open()
    VerifyScreenResolution
    Application.WindowState = xlMaximized
    End Sub
    An other problem is that when the original Screen Resolution is 800 X 600, and after it is changed by the previous code to 1024 X 768, the workbook window is minimized and it is maximized automaticcly even after using the following line with Workbook_Open code:

    Application.WindowState = xlMaximized

    Can you please find me a solution for that and tell my what is wrong with my code?

    Thanks a lot,
    Attached Files Attached Files
    Last edited by LoveCandle; 06-05-2009 at 01:56 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1