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
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,203
Office Version
  1. 2016
Platform
  1. Windows
Here is an ugly hack that might be close to what you want:

In the ThisWorkbook module:
VBA Code:
Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call AdjustZoom(Sh)
End Sub

Private Sub AdjustZoom(ByVal Sh As Object)

    Application.ScreenUpdating = False
    With ActiveWindow
        If Sh.UsedRange.Columns.Count > .VisibleRange.Columns.Count Then
            Do While Sh.UsedRange.Columns.Count >= .VisibleRange.Columns.Count - 3
                .Zoom = .Zoom - 1
            Loop
        Else
            Do While Sh.UsedRange.Columns.Count <= .VisibleRange.Columns.Count - 3
                .Zoom = .Zoom + 1
            Loop
        End If
    End With

End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Watch MrExcel Video

Forum statistics

Threads
1,130,142
Messages
5,640,372
Members
417,139
Latest member
bdmprasenjit

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