Unable to set userform left

[jdsouza]

I have a new notebook PC which has a 3200 x 2000 resolution. Recommended Scaling is 200%. Screen ratio is 16:10.

I have used VBA code to fetch the screen dimension, convert the fetched data to points. Subtract from it the userform width and thereby set its position to the right edge of the screen. On this new PC, the userform is sent approx 125 points too far to the left ( the right portion spills out of the screen). Even though I can see the maths working OK during the debug mode (the correct screen size, the correct userform width and the correct subtracted result is obtained), the userform is not painted at the correct distance from the left edge.

I have a suspicion that the userform is drawn wider than the set width. (I gather this when observing another userform which has a listview. There is more space to the right of the listview than expected - more space after the last column than designed). But the measurement of the userform in the VBE IDE debug mode returns the set dimensions.

Would appreciate any help with resolving this.

 

[rlv01]

I have a suspicion that the userform is drawn wider than the set width.

You should be able to prove that one way or the other by single-stepping through the VBA code that positions your form.

This is code I use to center a user form. If it does not do the same for you, then maybe something is going on in your monitor setup.

Private Sub UserForm_Activate()
    With Me                           ' Center Screen on whatever monitor Excel is running on
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)

        If .Height > Application.Height Then
            .ScrollHeight = .Height
            .Width = .Width * 1
            .Height = .Height * 0.8
            .Zoom = 100
            .Top = .Top + 60
            Me.KeepScrollBarsVisible = fmScrollBarsVertical
            Me.ScrollBars = fmScrollBarsVertical
        End If
    End With
End Sub

 

[jdsouza]

As mentioned in my post, single stepping does not shed any light because the maths returned is exactly as expected. But not the actual painting of the dialog box when used with the new laptop with a 16:10 ratio. I also mentioned in the post that the dialog boxes appear to be stretched but return the set dimensions when checked.

After much trial and error have given up and am using a branching code to send the dialog box to the right with different methods for the two different kinds of desktop screen. Case ratio of 1.6 and Case Else


' In userform code

Sub DoSendRight()

Dim Wt As Single
    Dim Ht As Single
    Dim Wt1 As Single
    Dim Ht1 As Single
    Dim dRat As Double
    Dim i As Integer
'    Wt1 = GetSystemMetrics(SM_CXFULLSCREEN)
'    Ht1 = GetSystemMetrics(SM_CYFULLSCREEN)
    Wt1 = GetSystemMetrics(0)
    Ht1 = GetSystemMetrics(1)
    Wt = Wt1
    Ht = Ht1
    

With Me
        CloseScreen   ' (application.screenupdating = False)
        ConvertPixelsToPoints Wt, Ht    '  Wt and Ht are retrieved in Points in this sub.  Ht is irrelevant
'        CloseScreen
        dRat = Round(Wt1 / Ht1, 4)   ' 
        Select Case dRat
         Case (16 / 10)   '  I use fractions to overcome difficulties in decimal symbol in VBA with foreign users with different regional settings
        .Left = Wt - (.Width + (.Width * ((1777778 / 1000000) - (Wt1 / Ht1))))  '  This gets me a few points short of the right edge
        While (ActiveWindow.PointsToScreenPixelsX(Me.Left + Me.Width)) > Wt - 5 ' (ActiveWindow.PointsToScreenPixelsX(Wt))
            Me.Left = Me.Left - 1
        Wend

        While ActiveWindow.PointsToScreenPixelsX(Me.Left + Me.Width) < Wt - 5 '((ActiveWindow.PointsToScreenPixelsX(Wt)))
            Me.Left = Me.Left + 1
        Wend
'   The While Wend routine strangely sends the dialog box exactly to the right edge.  The 16/10 case is for the new laptop situation where the Case Else code does not work (.Left = Wt - .Width)
        i = i + 1
        If i > 10000 Then Exit Sub   ' Added security to loop out in case of an infinite loop
        
        Case Else
            .Left = Wt - .Width
        End Select
'        .Show vbModeless
        OpenScreen   ' (application.screenupdating = True)
    End With
End Sub

 

[mikerickson]

I have a suspicion that the userform is drawn wider than the set width

A userform has both a .Width and an .InsideWidth property,

 

[jdsouza]

I have a suspicion that the userform is drawn wider than the set width

A userform has both a .Width and an .InsideWidth property,

Sure. But that has nothing to do with the issue.
Which is.
On this kind of PC where the ratio is 16:10 (as opposed to the 16:9 or 4:3), I find that I cannot send the userform to the right edge of the screen by code. The userform paints too far from the left edge (a bit of the userform is not seen as it has 'spilled over' to the right. The code is ....
Fetch the screen width in points. Subtract from that, the userform width which is in points and assign the userform.left = to the resultant value. This worked every time except for this new PC.
Would appreciate it if anyone provides a solution to figure out the userform.left value irrespective of the type of screen (Excel for Windows).