Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 8 of 8

Thread: Screen Resolution?

  1. #1
    Board Regular
    Join Date
    Mar 2002
    Posts
    60
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Does anybody know if in VBA it is possible to make sure that on opening an excel document the screen resolution is set to say 800x600?

    TIA

    Dan

  2. #2
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    Try,

    Sub GetScreenSize()
    Dim x As Long, y As Long, sYourMessage, iConfirm As Integer
    'x = GetSystemMetrics(SM_CXSCREEN)
    'y = GetSystemMetrics(SM_CYSCREEN)
    'If x < 1024 And y < 768 Then
    'sYourMessage = "Current screen size is " & x & " x " & y & vbCrLf
    sYourMessage = sYourMessage & "This screen is best viewed at 1024 x 768." & vbCrLf
    sYourMessage = sYourMessage & "Would you like to change the resolution?"
    iConfirm = MsgBox(sYourMessage, vbExclamation + vbYesNo, "Screen Resolution")
    If iConfirm = vbYes Then
    'Change screen settings
    Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3")
    End If
    'End If
    End Sub

    Some systems may not like this code. I use it and most systems take it. JSW

    PS. It works by prompting the user to set the resolution to what ever, then it pulls up the windows Display utility, so the user can slide the resolution over if needed. JSW

    [ This Message was edited by: Joe Was on 2002-03-28 06:50 ]

  3. #3
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    You may also try:

    Worksheets("Sheet1").PageSetup.Zoom = 80

    To set the sheet zoom to 80%. JSW

  4. #4
    Board Regular
    Join Date
    Mar 2002
    Posts
    60
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Works well thanks Joe

    Is there a way of just setting the resolution to avoid the screen settings requester coming on the screen?

    Thanks

    Dan

  5. #5
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

    Some time ago I did a macro that on open, got the current display resolution, comepaired it to the resolution wanted and if different saved the original resolution and set the current resolution to the resolution wanted. Then on exit it got the saved resolution and reset the current resolution to the original saved resolution.

    I looked for the code but it must be on another system or I lost it. I cannot remember the trick to setting the resolution directly? JSW

  6. #6
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-03-28 17:11, dan2 wrote:
    Works well thanks Joe

    Is there a way of just setting the resolution to avoid the screen settings requester coming on the screen?

    Thanks

    Dan
    Hi Dan
    Here is a routine i got together that does
    as Joe has said
    ie. Changes scrn resolution open open then
    restores upon close....had a bit of
    trouble restoring the taskbar and app.wnd
    but found a fix.

    I could have placed the settings on a worksheet but opted to Keep the old values
    in a variable via a Class Module.

    You will need
    1) Class module named cScreen
    2) A std module
    3) An entry in the Thisworkbook object

    Here they are;

    Option Explicit

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.Run ("Restore_Scrn")
    End Sub

    Private Sub Workbook_Open()
    Application.Run ("Set_Scrn")
    End Sub



    '2)

    Option Explicit
    '// Keep Old settings here
    '=========================
    Public dIniScrnW As Double
    Public dIniScrnH As Double
    Public nDC As Long
    '=========================

    '//>> Added Const to handle Update
    Private Const WM_DISPLAYCHANGE = &H7E
    Private Const HWND_BROADCAST = &HFFFF&
    Private Const BITSPIXEL = 12

    '//>>
    Private Const EWX_LOGOFF = 0
    Private Const EWX_SHUTDOWN = 1
    Private Const EWX_REBOOT = 2
    Private Const DM_PELSWIDTH = &H80000
    Private Const DM_PELSHEIGHT = &H100000
    Private Const CDS_UPDATEREGISTRY = &H1
    Private Const CCDEVICENAME = 32
    Private Const CDS_TEST = &H4
    Private Const DISP_CHANGE_SUCCESSFUL = 0
    Private Const DISP_CHANGE_RESTART = 1
    Private Const CCFORMNAME = 32

    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


    '// >>Added these API to fix screen update

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

    Sub ChangeScreen_Resol(dScrnW As Double, dScrnH As Double)
    Dim typDevM As typDevMODE
    Dim lResult As Long
    Dim iAns As Integer

    '// Retrieve info about the current graphics mode
    '// on the current display device.
    '// Note: Declared All Types
    '// other wise the Excel will crash
    lResult = EnumDisplaySettings(0, 0, typDevM)

    '// Set the new resolution.
    With typDevM
    .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    .dmPelsWidth = dScrnW '=800 'ScreenWidth (640,800,1024, etc)
    .dmPelsHeight = dScrnH '=600 'ScreenHeight (480,600,768, etc)
    End With

    '// Change the display settings to the specified graphics mode.
    lResult = ChangeDisplaySettings(typDevM, CDS_TEST)
    Select Case lResult
    Case DISP_CHANGE_RESTART
    iAns = MsgBox("You must restart your computer To apply these changes." & _
    vbCrLf & vbCrLf & "Do you want To restart now?", _
    vbYesNo + vbSystemModal, "Screen Resolution")
    If iAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
    Case DISP_CHANGE_SUCCESSFUL
    Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
    '//>> Fixed screen taskbar here! thanks to API net
    '//>> Notify all the windows of the screen resolution change
    Dim lScInfo As Long, lBits As Long
    lScInfo = dScrnW * 2 ^ 16 + dScrnH
    nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    lBits = GetDeviceCaps(nDC, BITSPIXEL)
    SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal lBits, ByVal lScInfo
    Case Else
    MsgBox "An error occured trying to set the display!"
    End Select


    End Sub



    Sub ClrD()
    'delete our device context
    DeleteDC nDC
    End Sub

    '1)

    Option Explicit
    ' // The GetSystemMetrics function retrieves various system metrics
    ' // and system configuration settings. System metrics are the dimensions
    ' // (widths and heights) of Windows display elements.
    ' // All dimensions retrieved by GetSystemMetrics are in pixels.
    Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
    Private Const SM_CXSCREEN = 0
    Private Const SM_CYSCREEN = 1
    Dim oScrn As cScreen 'Reference the New Class


    Private Sub Set_Scrn()
    '// Note: On some systems the Taskbar may need to be Reset/Repositioned
    '// do this manually by selecting and moving to the side and then
    '// moving back.
    '// Will look into a fix for this
    '// Fixed this Thanks to API net
    '// See >>



    On Error GoTo Ex
    '// Create a New instance of Class to reference
    Set oScrn = New cScreen
    With oScrn
    .dIniScrnH = GetSystemMetrics(SM_CYSCREEN) '600
    .dIniScrnW = GetSystemMetrics(SM_CXSCREEN) '800
    If .dIniScrnH <> 600 Or .dIniScrnW <> 800 Then
    Call .ChangeScreen_Resol(800, 600)
    End If
    End With

    Ex:
    Application.WindowState = xlMaximized

    End Sub



    Private Sub Restore_Scrn()
    ' //
    ' // Always restore back to the users
    ' // Original Screen settings !
    ' //
    ' // Incase of Error leave everything Alone
    On Error Resume Next
    Call oScrn.ChangeScreen_Resol(oScrn.dIniScrnW, oScrn.dIniScrnH)
    'delete our device context
    Call oScrn.ClrD
    Application.WindowState = xlMaximized
    On Error GoTo 0
    End Sub


    If this is not clear then I can send workbook
    Kind Regards,
    Ivan F Moala From the City of Sails

  7. #7
    New Member
    Join Date
    Nov 2010
    Posts
    25
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Screen Resolution?

    Ivan,

    Do you still have this workbook? I seem to be having the same problem everytime I click on a link that opens an excel workbook and generates a graph using macros.

  8. #8
    New Member
    Join Date
    Oct 2014
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Screen Resolution?

    Send me workbook please....
    My email is bm78ar@gmail.com...
    Thanks....

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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