VBA to set screen resolution on different PC's

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
Hello forum friends, I am hoping that someone can help me with some VBA code that will set the zoom level in my workbook so that when it is opened on virtually any other PC, the user will not have to adjust the resolution. My workbook contains 12 worksheets and each worksheet has varying column widths and row heights. I've spent a fair amount of time researching this here on MrExcel and on the Internet. I found some code on excel.tips.net that looked promising but when I run it, the first two lines of code turn red and there is a compile error (sub or function not defined). I note that this code contains two resolutions that are unlikely to be used much these days but if I can get the code to work, I can always adjust those to more mainstream 16:9 aspect ratios.

In case you haven't noticed, I don't know what I am doing. I know what I want to do, I just don't know how to do it! Any help or advice/suggestions will be much appreciated. Thanks!

Code:
Private Sub Workbook_Open()

    ScreenRes

End Sub

 

Declare Function GetSystemMetrics32 Lib "user32" _

    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

 

Public Sub ScreenRes()

    Dim lResWidth As Long

    Dim lResHeight As Long

    Dim sRes As String

 

    lResWidth = GetSystemMetrics32(0)

    lResHeight = GetSystemMetrics32(1)

    sRes = lResWidth & "x" & lResHeight

    Select Case sRes

        Case Is = "800x600"

            ActiveWindow.Zoom = 75

        Case Is = "1024x768"

            ActiveWindow.Zoom = 125

        Case Else

            ActiveWindow.Zoom = 100

    End Select

End Sub
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776
Well I just don't know. I tested the code and it works fine in my 32 bit installation. I'm not sure that I can help other than to mention that it is likely that if U mess with a users settings when U open there wb that it is likely that U should return them to there starting point in a wb close event in case the new settings carry over to the XL application (ie. other wb's) after your wb closes. Hmmm??? I'll see what else I have. Dave
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776
Module code...
Code:
#If VBA7 Then
    Public Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
#Else
    Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
#End If
Public Function ScreenRes(wsheet As Object)

    Dim lResWidth As Long

    Dim lResHeight As Long

    Dim sRes As String

 

    lResWidth = GetSystemMetrics(0)

    lResHeight = GetSystemMetrics(1)

    sRes = lResWidth & "x" & lResHeight

    Select Case sRes

        Case Is = "800x600"

            ScreenRes = 75

        Case Is = "1024x768"

            ScreenRes = 125

        Case Else

            ScreenRes = 100

    End Select

End Function
Workbook code...
Code:
Private Sub Workbook_Open()
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.Select
ActiveWindow.Zoom = ScreenRes(sht)
Next sht
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.Select
ActiveWindow.Zoom = 100
Next sht
End Sub
Not real sure that U need the before close code? Code tested and it works for 32bit me. Dave
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
Before I try your new code, is it possible that we have some miscommunication here? Both my laptop and my desktop systems are 64-bit. I never indicated that I had a 32-bit system but perhaps the code in my original post (I found it on the Intenet) was meant to be only for 32-bit systems. I think it's important that my workbook functions as both 32-bit and 64-bit and it never even occurred to me that there might be a compatibility issue in my VBA code. Does knowing this change your viewpoint/suggestion at all?
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@NdNoviceHlp Further to my previous post, I decided to go ahead and try your code and the line 'Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long' is still coming up in red text. So, the same problem exists. I'm waiting to hear what you think about my last post.
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776

ADVERTISEMENT

It's a real mystery that perhaps Jaafar or others can resolve. The whole point of the "#If VBA7 Then" etc. portion of the code is to provide the flexibility for either 32 or 64 bit installations. Your 64 bit instal should never even read the line U quoted as erroring??? Sorry I don't understan it either and I don't have a 64 bit instal to test on. Dave
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hey Dave, I did as you suggested and pasted the code 'as is' into a new module (module4). I also put the 'Call ScreenRes' into a 'workbook open' module on its own. Now the line of code after #Else is red, so I assume that means there is an issue... :oops:
No- That line being in red after #Else simply means that the code is running in vba7 (ie: excel 2010 or later) ... That line in red won't be compiled in excel 2010 or later . The fact that is red looks alarming but, it is ok - you can simply ignore it.

If you were running the code in excel 2007 or prior varsions (vba6), the line turning red would be the first one after the #If close.

Anyway, Dave's code in post#9 is correct and should work accross ALL platforms, regardless of the bitness of the excel application or the bitness of the OS.
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@Jaafar Tribak @NdNoviceHlp Thanks for steppin' in Jaffar. I tried Dave's code from post #12 because I figured the more recent one would likely be the correct one but when I email the file to my desktop (1600 X 900) I am getting an error (Run-time error '1004': Method 'Select' of object '_Worksheet' failed).

So I went back and copied his code from post #9 as you suggested and now it appears that it is working as intended except that it is not filling the screen on my desktop. Is that because the 1600 X 900 resolution is NOT listed as an option in the code? If that is the case, do I have to list every possible screen resolution in the code and what would that look like? Thanks again!
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows
Maybe someone in the forum has a better workaround but It is difficult to get the exact zoom right for every single display setting so you might want to try experimenting with every possible screen resolution and see what you get.

Are you more interested in filling the sheet horizontally than vertically (ie: you want to make sure all populated columns are on display within view)
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
Yes, to the horizontal for sure!! My worksheets (most of them) scroll vertically and that is not an issue but I would like them all to fill the screen horizontally. I definitely don't want the users to have to scroll horizontally and my worksheets will be more appealing visually if there is no blank space to the right side.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,089
Messages
5,640,048
Members
417,124
Latest member
Herostrata

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top