Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 24 of 24

Thread: Scale display vba code

  1. #21
    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

  2. #22
    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

  3. #23
    remove the word then

  4. #24
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    796
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •