VBA to set screen resolution on different PC's

[leopardhawk]

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!

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]

Here is an ugly hack that might be close to what you want:

In the ThisWorkbook module:

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