Excel Form Sizing is not correct

[HighStreetDave]

Hi there,

I have a UserForm which helps control user input. It needs to work on screens of different sizes, and I cannot get it to size correctly. The controls inside the form all size correctly to the size of the form, but the form itself is not correct. I have checked that the screen text sizing is at 100%, and also reset the form's base font back to default and the form zoom is at 100.

I'm designing it on a 1920x1080 screen, and I first noticed the issue when setting another form to 960 wide, where it displayed at something like 2/3 screen width rather than half. I have dropped my screen resolution to 1366x768 to match the laptops of our dealers, and when I set my main form to that size it displays much wider than that, encroaching on my second screen. The form reports being the right size, however.

I have tried moving the sizing code from the Initialize event to the Activate event to see if there is a difference, but it is still the same.

This is in Excel 2010 (many of our dealers use this) but I get the same result in Excel 2016)

None of the other posts I have found address this issue for me, hence my post.

Any ideas?

Here's the Initialize code:

Private Sub UserForm_Initialize()
'This code is run when the Main Menu form is first opened
  Set collTextboxes = New Collection
  Set collComboboxes = New Collection
  Set collCheckboxes = New Collection
  Set collButtons = New Collection
  Set collLabels = New Collection
  
Dim ScreenWidth, ScreenHeight As Long
ScreenWidth = GetSystemMetrics(0)
ScreenHeight = GetSystemMetrics(1)

MsgBox "Screen Width = " & ScreenWidth & Chr(10) & "Screen Height = " & ScreenHeight
'Me.Zoom = 100

Me.Width = ScreenWidth
Me.Height = ScreenHeight
Me.Left = 0
Me.Top = 0

MsgBox Me.Width
End Sub

And here's the Activate code (which now does no form sizing):

Private Sub UserForm_Activate()
  'Position the controls relative to the size of window
  lblTitle.Left = 0
  lblTitle.Top = 0
  lblTitle.Width = Me.Width
  Image1.Left = Me.Width - Image1.Width - 10
  Image1.Top = 0
  lblVersionNumber.Top = 10
  lblVersionNumber.Left = Image1.Left - lblVersionNumber.Width - 10
  lblVersionNumber.Caption = Sheets("Tables").Cells(1, 2).value
  MultiPage1.Left = 10
  MultiPage1.Top = Image1.Height + 4
  MultiPage1.Width = Me.Width - 20
  MultiPage1.Height = Height - MultiPage1.Top - 30
  'Clear out any existing items in the combo box, then add from 1 to 10 as options
  cboSystems.Clear
  cboSystems.AddItem "1"
  cboSystems.AddItem "2"
  cboSystems.AddItem "3"
  cboSystems.AddItem "4"
  cboSystems.AddItem "5"
  cboSystems.AddItem "6"
  cboSystems.AddItem "7"
  cboSystems.AddItem "8"
  
  lstSummary.Left = 10
  lstSummary.Width = MultiPage1.Width - 20
  lstSummary.Top = 10
  lstSummary.Height = MultiPage1.Height - 120
End Sub

 

[Jaafar Tribak]

The width and Height of a userform are in Points whereas the GetSystemMetrics API here return them in Pixels.

I think you will have to convert the pixels to points .. somethig like this :

ScreenWidth = GetSystemMetrics(0) * 0.75
ScreenHeight = GetSystemMetrics(1) * 0.72

 

[HighStreetDave]

Thanks Jaafar, that really helps. I found a bit of code that does this just that (I can't remember where from) a day or so later. In a module you have these lines:

Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Const LOGPIXELSX = 88  'Pixels/inch in X
Public Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches

Public Function PointsPerPixel() As Double
 Dim hDC As Long
 Dim lDotsPerInch As Long

 hDC = GetDC(0)
 lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
 PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
 ReleaseDC 0, hDC
End Function

And then in UserForm_Initilaise I added:

Dim ScreenWidth, ScreenHeight As Long
  Me.Left = 0
  Me.Top = 0
  ScreenWidth = GetSystemMetrics(0)
  ScreenHeight = GetSystemMetrics(1)
  Me.Width = Int((ScreenWidth - 4) * PointsPerPixel) '-4 for the window border
  Me.Height = Int((ScreenHeight - 40) * PointsPerPixel) '-40 for the task bar

I added a "fudge factor" because the border of the window does not seem to be included in the window size, meaning that the border was drawn off the screen, and I also took away some height because of the Windows Task Bar.

Many thanks.

Dave

 

[NdNoviceHlp]

Hi Dave. This link might also be helpful. Dave
https://www.mrexcel.com/forum/excel...s-incorrectly.html?highlight=GetSystemMetrics