fit controls to screen vba - 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

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

Answer 2

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