fit controls to screen vba

Question

i'm trying to fit the user form to screen on diifernet screens.

the userform was first managed in my work screen and i fit it to my screen but when i'm trying the userform on other screens part of it vanished.

i can't put the whole code in here but i will put just the sub that suppose to fit to screen:

Private Sub UserForm_Initialize()
Dim w As Long, h As Long
Application.Visible = False

With Me
        rMaxHeight = Application.Height
        rMaxWidth = Application.Width
        If .Height > Application.Height - 10 Then
        rNormalHeight = rMaxHeight * 0.85
        Else
        rNormalHeight = Me.Height
        End If
        If .Width > Application.Width - 10 Then
        rNormalWidth = rMaxWidth * 0.85
        Else
        rNormalWidth = Me.Width
        End If

        .StartUpPosition = 1
        .Left = 0
        .Top = 0
         FitSize
...

Private Sub FitSize()
Dim h, w
Dim c As Control
Dim PHeight, PWidth As Double

PHeight = rNormalHeight / Me.Height
PWidth = rNormalWidth / Me.Width
h = 0: w = 0

If PHeight = 1 And PWidth = 1 Then Exit Sub

    For Each c In Me.Controls
        If c.Visible Then
            If c.Top + c.Height > h Then h = (c.Top + c.Height) ' * PHeight

            If c.Left + c.Width > w Then w = (c.Left + c.Width) ' * PWidth

            If Not TypeName(c) = "Image" Or TypeName(c) = "ListBox" Then   c.FontSize = c.FontSize * ((PHeight + PWidth) / 2)
        End If
    Next c

    If h > 0 And w > 0 Then
        With Me
            .Width = w + 40
            .Height = h + 40
        End With
    End If
End Sub

hope you could help me with that

Thank you all sefi

Answer 1

Hello and thank for everyone that tried to help me. I found the solution to this problem by fitting the controls to the proportion of the screen copared with the original form.

At first step you need to calculate the proportion:

Dim PHeight, PWidth As Double
'define form size compared with the original size of the form
rMaxHeight = Application.Height
rMaxWidth = Application.Width
If Me.Height > Application.Height Then
rNormalHeight = rMaxHeight * 0.85
Else
rNormalHeight = Me.Height
End If
If Me.Width > Application.Width Then
rNormalWidth = rMaxWidth * 0.85
Else
rNormalWidth = Me.Width
End If
 'normal is the size needed in normal mode before the form get to maximize mode
 'we want to calculate the needed divided to the orignal
PHeight = rNormalHeight / Me.Height
PWidth = rNormalWidth / Me.Width

now we call fitsize()

Private Sub FitSize()
Dim h, w
Dim c As Control

h = 0: w = 0

If PHeight = 1 And PWidth = 1 Then Exit Sub ' if the it is the original size of the form- don't bother...

'loop on the form controls
For Each c In Me.Controls
   If c.Visible Then                                     ' just visible controls
      c.Top = c.Top * PHeight                            ' fit to proportion of the screen compared with the original form
      c.Height = c.Height * PHeight
      If c.Top + c.Height > h Then h = c.Top + c.Height  ' collect the height needed from the controls

      c.Left = c.Left * PWidth                           ' fit to proportion of the screen compared with the original form
      c.Width = c.Width * PWidth
      If c.Left + c.Width > w Then w = c.Left + c.Width  ' collect the height needed from the controls

      'fit the font for the text controls
      If Not TypeName(c) = "Image" Or TypeName(c) = "ListBox" Then c.FontSize = c.FontSize * ((PHeight + PWidth) / 2)
      End If
Next c

'define the size needed form the specific screen
If h > 0 And w > 0 Then
    With Me
      .Width = w + 40
      .Height = h + 40
      .StartUpPosition = 0
      .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
      .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
     End With
End If

End Sub

this code will define the size needed in each screen by the proportion that calculated in the needed value divded to the original value.

Try it and tell me if it works.

thank you all sefi

Answer 2

You can either Re-position every single control in the UserForm with VBA or simply enable ScrollBars for the UserForm object so they can access all the elements with a bit of scrolling.

Change the ScrollBars property of the UserForm to like 3 - fmScrollBarsBoth as the default is 0 - fmScrollBarsNone

Then you need to figure out how tall and wide it needs to be:

• ScrollHeight
• ScrollWidth