Userform size displays incorrectly

[ilya2004]

Hi,

I have created a tool for many users in my company. The interface is built around a main userform. I am having an issue with only one user where the userform seems to be so zoomed in on her screen that she is not able to access all of the content. I check her resolution and it is the same as mine, so I don't know why it does not fit on her screen, but it fits on mine.

Has anyone seen anything like this before?

Thanks,
Ilya

 

[NdNoviceHlp]

The personalization screen setting will also affect the userform size. HTH. Dave

 

[ilya2004]

The personalization screen setting will also affect the userform size. HTH. Dave

Would you mind elaborating?

 

[NdNoviceHlp]

The DPI setting is not the same as screen resolution. Right click the desktop screen and go to personalize to adjust DPI setting. This will change the presentation size of a userform. Dave

 

[ilya2004]

The DPI setting is not the same as screen resolution. Right click the desktop screen and go to personalize to adjust DPI setting. This will change the presentation size of a userform. Dave

Perfect, the DPI was the issue. Thanks!!

 

[jsotola]

i have come across this issue with ActiveX controls

it is a bug where windows will change the size if the controls whenever it sees fit

 

[NdNoviceHlp]

Here's some code to fix it. It will adjust the form and resize all controls. HTH. Dave
Module code....

Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public X  As Long
Public Y  As Long

Public Type ControlPositionType
    Left As Single
    Top As Single
    Width As Single
    Height As Single
    FontSize As Single
End Type

Public m_ControlPositions() As ControlPositionType
Public m_FormWid As Double
Public m_FormHgt As Double

' Save the form's and controls' dimensions.
Public Sub SaveSizes(UF As Variant)
Dim i As Integer
Dim ctl As Control
    ' Save the controls' positions and sizes.
    ReDim m_ControlPositions(1 To UF.Controls.Count)
    i = 1
    
    For Each ctl In UF.Controls
        With m_ControlPositions(i)
                .Left = ctl.Left
                .Top = ctl.Top
                .Width = ctl.Width
                .Height = ctl.Height
                On Error Resume Next
                .FontSize = ctl.Font.Size
                On Error GoTo 0
        End With
        i = i + 1
    Next ctl

    ' Save the form's size.
    m_FormWid = UF.Width
    m_FormHgt = UF.Height
End Sub

Userform code....

' Arrange the controls for the new size.
Private Sub ResizeControls(UF As Variant)
Dim i As Integer
Dim ctl As Control
    ' Get the form's current scale factors.
    x_scale = UF.Width / m_FormWid
    y_scale = UF.Height / m_FormHgt

    ' Position the controls.
    i = 1
    For Each ctl In Controls
        With m_ControlPositions(i)
                ctl.Left = x_scale * .Left
                ctl.Top = y_scale * .Top
                ctl.Width = x_scale * .Width
                    ' Cannot change height of ComboBoxes.
                    ctl.Height = y_scale * .Height
                On Error Resume Next
                ctl.Font.Size = y_scale * .FontSize
                On Error GoTo 0
        End With
        i = i + 1
    Next ctl
End Sub

Private Sub UserForm_Initialize()
Dim Wtemp As Double, HTemp As Double
Call SaveSizes(UserForm1)
X = GetSystemMetrics(SM_CXSCREEN)
Y = GetSystemMetrics(SM_CYSCREEN)
'design form at 1024 x 768 resolution
Wtemp = (X - 1024) / 1024
'adjust .65 width to suit (form fills %65 of screen width)
Wtemp = 0.65 - Wtemp / 2 * 0.65
HTemp = (Y - 768) / 768
'adjust .9 height to suit (form fills %90 of screen height)
HTemp = 0.9 - HTemp / 2 * 0.9
Me.Width = Application.UsableWidth * Wtemp
Me.Height = Application.UsableHeight * HTemp
End Sub

Private Sub UserForm_Resize()
Call ResizeControls(UserForm1)
End Sub

ps. Change "Userform1" to name of relevant userform

 

[jsotola]

if your form is resizing for some users when they open the workbook
then changing the form size by very slightly and repainting may fix the problem

do the fix at workbook open time

here is a snippet

    If frm.Width = 321 Then
        frm.Width = 320
    Else
        frm.Width = 321
    End If
    
    frm.Repaint