Solved: Adjust Screen Resolution

[av8tordude]

I posted this in MrExcel but gotten no response. Just hoping to get some help here.

http://www.mrexcel.com/forum/showthread.php?p=1770879#post1770879

Is there any way this code could check for a specific screen resolution and if the screen resolution matches the define resolution...

1. do nothing and continue to load the application or

2. inform me of the my current resolution and ask if I want to change it.

Also, i would like to try out a code that will change the resolution automatically to the define setting or the highest resolution available but not higher than the define setting?

I would like to try both to see what works. thanks





Option Explicit

'** Code by Joe Was
'This must be the first line in a Standard Module, like: Module1!
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
'This must be the fifth line in a Standard Module, like: Module1!
Public myScrHight&


Sub ScreenSize()
'Automatically reset screen resolution!
Dim xWide&, yHigh&, myMsg$, iWillConfr%, myCode&

xWide = GetSystemMetrics(SM_CXSCREEN)
yHigh = GetSystemMetrics(SM_CYSCREEN)

'Optional exact screen resolution test!
'If ((xWide < 1024 And yHigh < 768) Or (xWide > 1024 And yHigh > 768)) Then
myMsg = "Current screen size is " & xWide & " x " & yHigh & vbCrLf
myMsg = myMsg & "This screen is best viewed at 1024 x 768." & vbCrLf
myMsg = myMsg & "Would you like to change the resolution?"
iWillConfr = MsgBox(myMsg, vbExclamation + vbYesNo, "Screen Resolution")

If iWillConfr = vbYes Then
'Change screen settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3")
End If
'End If

xWide = GetSystemMetrics(SM_CXSCREEN)
yHigh = GetSystemMetrics(SM_CYSCREEN)
myCode = (xWide * yHigh)

End Sub