Scale display vba code

[arnelgp]

Public Function ScreenResToZoom(DPIScaler As Double)
    Select Case DPIScaler
        Case Is < 201
            ScreenResToZoom = 100
            then Me.Top = (Application.Height - 75 - Me.Height)
        Case Is < 301
            ScreenResToZoom = 95
            then Me.Top = (Application.Height - 100 - Me.Height)
        Case Is < 401
            ScreenResToZoom = 85
            then Me.Top = (Application.Height - 125 - Me.Height)
        Case Is < 501
            ScreenResToZoom = 70
            then Me.Top = (Application.Height - 150 - Me.Height)
        Case Else
            ScreenResToZoom = 50
            then Me.Top = (Application.Height - 75 - Me.Height)
    End Select
ActiveWindow.Zoom = ScreenResToZoom

 End Function

[chubbychub]

i get red lines and when macro is ran its says compile error

Public Function ScreenResToZoom(DPIScaler As Double)
    Select Case DPIScaler
        Case Is = >100 to 200
            ScreenResToZoom = 100
            then Me.Top = (Application.Height - 75 - Me.Height)  '<------red lines here
        Case Is = >201 to 300
            ScreenResToZoom = 95
            then Me.Top = (Application.Height - 100 - Me.Height)   '<------red lines here
        Case Is = >301 to 400
            ScreenResToZoom = 85
            then Me.Top = (Application.Height - 125 - Me.Height)   '<------red lines here
        Case Is = >401 to 500
            ScreenResToZoom = 70
            then Me.Top = (Application.Height - 150 - Me.Height)   '<------red lines here
        Case Else
            ScreenResToZoom = 50
            then Me.Top = (Application.Height - 75 - Me.Height)   '<------red lines here
    End Select
ActiveWindow.Zoom = ScreenResToZoom


End Function

[arnelgp]

remove the word then

[Dave]

HI CC. I'm not quite sure that you want to change the sheet zoom with changes to the scale? I don't have any large monitors with that high a screen resolution or the need to scale at 400%. My largest monitor with highest scale makes all the sheet rows really thin and requires a change to the sheet zoom just to see them. So I'll assume that's what's needed. I would start with the monitor(s) at 100% scale and see how many rows are visible and then jigger with the "ScreenResToZoom" values at each scale level until the same number of rows are displayed. If you don't want to change the sheet zoom, then I left an example within the "ScreenResToZoom" function where you can adjust the userform display height for each scale (remove the zoom part and the userform placement code in the "ScreenInfo" sub.) .You will need to adjust the userform name to suit. Unfortunately, this is where you find out that the scale factor (and screen resolution) also effects the size of your userform and controls. So you will need to adjust them as well. One thing at a time. HTH. Dave

Sub ScreenInfo()Dim DPIScale As Double, DPIScale2 As Double
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
DPIScale = GetDpi
If DPIScale <> 96 Then
DPIScale = (1 + ((DPIScale - 96) / 96)) * 100
Else
DPIScale = 100
End If
'MsgBox "Screen Resolution: " & X & " x " & Y & vbCrLf _
& "Scale: " & DPIScale & "%"


UserForm1.StartUpPosition = 0
Call ScreenResToZoom(DPIScale)
UserForm1.Left = Application.Left + (0.5 * Application.Width) - (0.5 * UserForm1.Width)
UserForm1.Top = Application.Top + (0.9 * Application.Height) - (0.9 * UserForm1.Height)
UserForm1.Show
End Sub


Public Function ScreenResToZoom(DPIScaler As Double)
    Select Case DPIScaler
        Case 100
            ScreenResToZoom = 100
        Case 100 To 199
            ScreenResToZoom = 85
            'UserForm1.Left = Application.Left + (0.5 * Application.Width) _
                                                     - (0.5 * UserForm1.Width)
            'UserForm1.Top = Application.Top + (0.9 * Application.Height) _
                                                     - (0.9 * UserForm1.Height)
        Case 200 To 299
            ScreenResToZoom = 70
        Case 300 To 399
            ScreenResToZoom = 55
        Case 400 To 499
            ScreenResToZoom = 40
        Case Else
            ScreenResToZoom = 30
   End Select
ActiveWindow.Zoom = ScreenResToZoom
End Function