VBA to set screen resolution on different PC's

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
611
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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
U can trial this for a 32 bit office installation
Module code...
Code:
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Change these 2 lines in your code....
Code:
lResWidth  = GetSystemMetrics(0)
lResHeight = GetSystemMetrics(1)
HTH. Dave
 
Upvote 0
@NdNoviceHlp Hi Dave, thanks for reaching out. I didn't realize that the code I had copied off the Internet was for 32-bit systems. I am running 64-bit and after I tried your suggestion, I am getting an error telling me such.

This brings up another concern, I hope there is a way to do this without any consideration for what the O/S is...???
 
Upvote 0
Module code...
Code:
#If VBA7 Then
    Private 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
Dave
 
Upvote 0
@NdNoviceHlp since I wasn't sure where to put this bit of code in your last post, I added as below and I am now getting the following error:

"Compile error: The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute."
Code:
Private Sub Workbook_Open()

    ScreenRes

End Sub

 

#If VBA7 Then

    Private Declare 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 Sub ScreenRes()

    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"

            ActiveWindow.Zoom = 75

        Case Is = "1024x768"

            ActiveWindow.Zoom = 125

        Case Else

            ActiveWindow.Zoom = 100

    End Select

End Sub
 
Upvote 0
PtrSafe Keyword is missing

VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
#End If
 
Upvote 0
leopardhawk the code needs to be placed in a module (as previously indicated) however they should both be Public... whoops my bad. HTH. Dave
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
 
Upvote 0
Okay, I'm sorry but I'm really confused. I really appreciate the help offered so far. I should point out that the initial piece of code in my original post was just something I picked up on the Internet and I am in no way attached to it. I was just hoping that there is a simple way to do what I am trying to do and that is come up 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. Perhaps I should just start over but I'm not even sure where to start. :censored:

My mantra: I know what I want to do, I just don't know how to do it!
 
Upvote 0
In the VB editor where code goes, click on insert, select module and copy and paste this 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 Sub ScreenRes()

    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"

            ActiveWindow.Zoom = 75

        Case Is = "1024x768"

            ActiveWindow.Zoom = 125

        Case Else

            ActiveWindow.Zoom = 100

    End Select

End Sub
In your workbook code...
Code:
Private Sub Workbook_Open()

    Call ScreenRes

End Sub
Dave
 
Upvote 0
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:
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

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
Back
Top