Warn the user that the application needs to be viewed at a set resolution, like many games do!
Put code that re-sizes the screen, call it from the ThisWorkbook Open Event. Then in the Before Close Event put it back the way the user had.
This is the basic code to work with the resolution on a Windows PC. [It works on all the versions I have tested it on, up to xp Pro.]
'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 ChScreenSize()
'Ask user to change Resolution.
'Supply Display Utility to change resolution!
Dim myMsg$, iWillConfr%
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 Sub
Sub ShowMyRes()
'Show current resolution!
Dim myWidth&, myHight&, myCode&, myRes$, myFlag As Boolean
myWidth = GetSystemMetrics(SM_CXSCREEN)
myHight = GetSystemMetrics(SM_CYSCREEN)
myCode = (myWidth * myHight)
Select Case myCode
Case 204544
myRes = myWidth & " x " & myHight '[544 x 376]
Case 307200
myRes = myWidth & " x " & myHight '[640 x 480]
Case 368640
myRes = myWidth & " x " & myHight '[720 x 512]
Case 480000
myRes = myWidth & " x " & myHight '[800 x 600]
Case 786432
myRes = myWidth & " x " & myHight '[1024 x 768]
Case 1016064
myRes = myWidth & " x " & myHight '[1152 x 882]
Case 1036800
myRes = myWidth & " x " & myHight '[1152 x 900]
Case 1310720
myRes = myWidth & " x " & myHight '[1280 x 1024]
Case 1920000
myRes = myWidth & " x " & myHight '[1600 x 1200]
Case 2304000
myRes = myWidth & " x " & myHight '[1920 x 1200]
Case 2592000
myRes = myWidth & " x " & myHight '[1800 x 1440]
Case Else
myRes = "A custom or non-standard resolution of:" & _
vbCr & vbCr & " Size: " & _
myWidth & " x " & myHight
myFlag = True
End Select
If myFlag = False Then
MsgBox "The current system screen resolution is:" & vbCr & _
"A standard screen resolution of:" & vbCr & vbCr & _
" Size: " & myRes & vbCr & vbCr & _
"Psudo-Code: " & myCode
ElseIf myFlag = True Then
MsgBox "The current system screen resolution is: " & vbCr & _
myRes & vbCr & vbCr & "Psudo-Code: " & myCode
End If
End Sub
Sub TestReSetScrSize()
'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)
Select Case myCode
Case 480000
Application.DefaultWebOptions.ScreenSize = msoScreenSize800x600 '[800 x 600]
Case Else
Application.DefaultWebOptions.ScreenSize = msoScreenSize1024x6768 '[1024 x 768]
End Select
End Sub