Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'---------------------------------
Public Function GetSR() As Variant
GetSR = Array(GetSystemMetrics(0), GetSystemMetrics(1))
End Function
'-----------------
Sub ResizeForm_R1()
' Adjusts userform size to compensate for screen resolution changes.

'Call function to get actual screen resolution
varSize = GetSR
resX = varSize(0)
resY = varSize(1)

'Determine ratio of actual screen resolution to
'the original or base resolution.
RatioX = resX / UserForm1.Width
RatioY = resY / UserForm1.Height
RY = 3.5
RX = 1.66

Fact = 1 ' 1 = full screen
'Adjust userform magnification and size.
UserForm1.Zoom = 100 * RatioX / 1.66 / Fact
UserForm1.Width = UserForm1.Width * RatioX / RX / Fact
UserForm1.Height = UserForm1.Height * RatioY / RY / Fact
UserForm1.Show
End Sub

Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Public Declare Function GetWindowRect Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     ByRef lpRect As RECT) As Long

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


Sub AdattaForm(frm As String)

Dim hwndDesk As Long
Dim DeskRect As RECT
Dim DeskH As Long, DeskW As Long
Dim ProjW As Integer, ProjH As Integer
Dim OrigW As Integer, OrigH As Integer
Dim r As Integer, nz As Integer
Dim i As Integer, frmIndex As Integer

For i = 0 To UserForms.Count
    If UserForms(i).Name = frm Then
        frmIndex = i
        Exit For
    End If
Next i
        
ProjW = 1600   'imposto la risoluzione di progettazione
ProjH = 900

hwndDesk = GetDesktopWindow
GetWindowRect hwndDesk, DeskRect
DeskW = DeskRect.Right - DeskRect.Left
DeskH = DeskRect.Bottom - DeskRect.Top

OrigW = UserForms(frmIndex).Width
OrigH = UserForms(frmIndex).Height

UserForms(frmIndex).Width = (OrigW * DeskW) / ProjW
UserForms(frmIndex).Height = (OrigH * DeskH) / ProjH
nz = (UserForms(frmIndex).Zoom * DeskH) / ProjH
NewZoom = IIf(nz > 400, 400, IIf(nz < 10, 10, nz))
UserForms(frmIndex).Zoom = NewZoom

End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub
Private Sub UserForm_Initialize()
'by scossa e marius

Dim nWd As Double
  With Me
    nWd = Application.Width / .Width
    .Top = Application.Top
    .Left = Application.Left
    .Width = Application.Width / 2
    .Height = Application.Height / 2
    .Zoom = (Round(nWd, 1) * 100) / 2
  End With
End Sub

Dim controlli As Control
For Each controlli In Me.Controls
    If TypeOf controlli Is MSForms.Frame Then
         controlli.Font.Size = 11
     Else
         controlli.FontSize = 10
    End If
Next controlli

Sub UserForm_Initialize()
Application.WindowState = xlMaximized
    Zo_W = Application.Width / UserForm1.Width
    Zo_H = Application.Height / UserForm1.Height
    If Zo_W < Zo_H Then
        mZoom = Zo_W
    Else
        mZoom = Zo_H
    End If
    
    mZoom = mZoom * 1 ' < < = = = = =  1 è un fattore di aggiustamento cambia al variare della risoluzione
    mH = UserForm1.Height
    mW = UserForm1.Width
    UserForm1.Width = UserForm1.Width * mZoom
    UserForm1.Height = UserForm1.Height * mZoom
    
    Zo_W = UserForm1.Width / mW
    Zo_H = UserForm1.Height / mH
    For Each ctr In UserForm1.Controls
        ctr.Width = ctr.Width * Zo_W
        ctr.Height = ctr.Height * Zo_H
        ctr.Font.Size = ctr.Font.Size * Zo_H * 1
        ctr.Top = ctr.Top * Zo_H
        ctr.Left = ctr.Left * Zo_W
    Next
End Sub

Option Explicit

Private Sub UserForm_Initialize()
Dim x As Double, h As Double, alta As Double, larga As Double
Dim xa As Double, ha As Double, rap1 As Double, rap2 As Double
x = Application.UsableWidth
h = Application.UsableHeight
alta = Me.Height
larga = Me.Width
If x > 597 Then
    xa = x / 597
    ha = h / 309
    With Me
        .Top = 1
        .Left = 1
        .Height = Application.UsableHeight + 140
        .Width = Application.UsableWidth
        If .Height > alta Then rap1 = ha Else rap1 = 1 / ha
        If .Width > larga Then rap2 = xa Else rap2 = 1 / xa
    End With
    For Each ctr In Me.Controls
        ctr.Width = ctr.Width * rap2
        ctr.Height = ctr.Height * rap1
        ctr.Font.Size = ctr.Font.Size * rap2
        ctr.Top = ctr.Top * rap1
        ctr.Left = ctr.Left * rap2
    Next
End If
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Option Explicit
Const ZoomStep = 1
Dim Grow As Single

Sub ctlResize(ByVal ctl As MSForms.Control)
    With ctl
        .Height = .Height / Grow
        .Width = .Width / Grow
        .Left = .Left / Grow
        .Top = .Top / Grow
    End With
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub SpinButton1_Change()
Dim oldZ As Long
    With Me
        oldZ = Zoom
        .Zoom = .SpinButton1.Value
        Grow = Zoom / oldZ
        .Height = .Height * Grow
        .Width = .Width * Grow
        ctlResize .SpinButton1
        ctlResize .Label1
        With .Label1
            .Font.Size = .Font.Size / Grow
        End With
    End With
End Sub

Private Sub UserForm_Initialize()
    With Me.SpinButton1
        .Value = Me.Zoom
        .SmallChange = ZoomStep
    End With
End Sub