Alter Display Settings Using Excel VBA 3

[OzzieOwl]

Hi

I have an Excel spreadsheet that is best viewed with Display Properties of 1024 x 768 pixels, is there anyway I can pick up what the users display settings are, then change them to 1024 x 768 when the spreadsheet is opened, then when the spreadsheet is closed set them back to the users original settings.

Any help greatly appreciated.

Cheers

Ozzie

 

[BrainB]

This is how to check screen resolution. I don't know how to change it.

' ----------------------------------------------
Private Declare Function GetSystemMetrics _
Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
'------------------------------------------


'-------------------
Sub GET_WINDOW_SIZE()
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
MsgBox ("Window size is " & x & " x " & y)
End Sub
'-----------------------------------------------


Regards
BrianB
Use CupOfCoffee to speed up all windows applications
================================

 

[xlbo]

try searching the archives - this came up on a search for "Screen Size"
thread705-648620

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[strongm]

But be warned, users may not like it if you arbitarily change their carefully selected screen resolution...

 

[xlbo]

Strongm - that's why I highlighted that thread in particular as it had just such a discussion

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[OzzieOwl]

Thanks guys. I Appreciate the points raised. I think I might just state that the Document is best viewed with certain screen settings, then it is up to the user.

Ozzie

 

[dyarwood]

Surely you could use a message box to tell the use how it is best viewed and in the same box have a "Do you want to change to this view" with a yes no button. if they click yes call the function to change the view if no just end the sub.

dyarwood

 

[OzzieOwl]

Sounds like a good Idea, I will give it a go.

Cheers

Ozzie

 

[dyarwood]

Another thought would be if you can get an on close of the spreadsheet, bring up another message box to let the user choose if they want to return to the screen settings they had earlier. This might mean capturing the screen settings or give the options available in a list box maybe. Saves people coming to IT asking to have them changed back again.

dyarwood

 

[Bowers74]

You could also check and see what zoom level setting your workbook would need if viewed at various screen resolutions and then use a macro to set the zoom setting according to the screen resolution that you can get by using BrianB's solution.

For example:

640 x 480 Resolution = 50% Zoom
800 x 600 Resolution = 75% Zoom
1024 x 768 Resolution = 100% Zoom
1280 x 1024 Resolution = 125% Zoom

That might help too!



Peace!!

Mike

Didn't get the answers that you wanted? Take a look at FAQ219-2884

 

[Bowers74]

I found this in my archives, but I can't rmember where I got it from.

Option Explicit

Private Declare Function EnumDisplaySettings Lib "user32" _
        Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName _
        As Long, ByVal iModeNum As Long, lpDevMode As Any) _
        As Boolean
        
Private Declare Function ChangeDisplaySettings Lib "user32" _
        Alias "ChangeDisplaySettingsA" (lpDevMode As Any, _
        ByVal dwFlags As Long) As Long

Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H4
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const ENUM_CURRENT_SETTINGS = &HFFFF - 1

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
------------------------------------------------------------
Private Sub ScreenResolution()
Dim x As Long, y As Long
Dim Index As Integer, MsgStr As String

MsgStr = vbLf & "Please the index for the screen resolution "
MsgStr = MsgStr & vbLf & "that you would like to change to:"
MsgStr = MsgStr & vbLf & vbLf
MsgStr = MsgStr & "0 = 800 x 600" & vbLf
MsgStr = MsgStr & "1 = 1024 x 768" & vbLf
MsgStr = MsgStr & "2 = 1152 x 864" & vbLf
MsgStr = MsgStr & "3 = 1280 x 1024" & vbLf
MsgStr = MsgStr & "4 = 1600 x 1200" & vbLf

On Error Resume Next

Index = InputBox(MsgStr, "Change Screen Resolution")

    Select Case Index
      Case 0: x = 800: y = 600
      Case 1: x = 1024: y = 768
      Case 2: x = 1152: y = 864
      Case 3: x = 1280: y = 1024
      Case 4: x = 1600: y = 1200
    End Select

Call SetScreen(x, y)

End Sub
------------------------------------------------------------
Private Sub SetScreen(ByVal x&, ByVal y&)
  Dim Result&
  Dim Dev As DEVMODE

    Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, Dev)
    Dev.dmDisplayFrequency = 90
    Dev.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    Dev.dmPelsWidth = x
    Dev.dmPelsHeight = y
   
    Result = ChangeDisplaySettings(Dev, CDS_TEST)
    ChangeDisplaySettings Dev, CDS_UPDATEREGISTRY
End Sub

Run the Procedure ScreenResolution, but do it with caution. I tested it and it worked for me, but if you press the cancel button in the InputBox, your resolution will automatically be set to 800 x 600.

Enjoy!



Peace!!

Mike

Didn't get the answers that you wanted? Take a look at FAQ219-2884

 

[Chattin]

This may be of some use - not sure though

http://j-walk.com/ss/excel/tips/tip06.htm

HTH

Chris ;-)

Visit

http://www.mrexcel.com/board/index.php

for great xl and xl/VBA help