Dutch Gemini's Weblog Pages

March 14, 2011

Excel fails to center Userform correctly on Dual Screens

Editor’s Note: this post has been updated with the comments and the code example integrates the necessary corrections.

If you prefer working in pixels (used by Windows) instead of screen points (by Excel/VBA) then you may want to explore the following functions from Win32 API for the placement of the UserForm on screen: GetWindowRect() and SetwindowPos().

 


Since some time I’m working dual screen (recently I’ve moved to 3 screens on my workplace, and I can’t tell you how happy I am with it).

At the time I made the switch I immediately noticed that Excel (it was 2002, but also 2003 and higher have this problem) couldn’t correctly position the UserForm on the correct screen when using CenterOwner or CenterScreen as the form’s StartupPosition.

I’ve found a solution for this problem using a few Win32 API’s. Here it is:

Put this in a Module:

Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

' Used for getting the metrics of the system devices.
'
Public Const SM_XVIRTUALSCREEN As Long = &H4C&
Public Const SM_YVIRTUALSCREEN As Long = &H4D&
Public Const SM_CXVIRTUALSCREEN As Long = &H4E&
Public Const SM_CYVIRTUALSCREEN As Long = &H4F&
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const TWIPSPERINCH = 1440

' Helper for the Select Case...
'
Public Enum StartupPosition
    Manual = 0
    CenterOwner = 1
    CenterScreen = 2
    WindowsDefault = 3
End Enum

Public Sub AdjustStartupPosition(ByRef pUserForm As Object, _
                                 Optional ByRef pOwner As Object)
On Error Resume Next
    Dim wVirtualScreenLeft   As Single
    Dim wVirtualScreenTop    As Single
    Dim wVirtualScreenWidth  As Single
    Dim wVirtualScreenHeight As Single

    ' Get coordinates of top-left corner and size of entire screen (stretched over
    ' all monitors) and convert to Points.
    '
    wVirtualScreenLeft = GetSystemMetrics(SM_XVIRTUALSCREEN)
    wVirtualScreenTop = GetSystemMetrics(SM_YVIRTUALSCREEN)
    wVirtualScreenWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN)
    wVirtualScreenHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN)
    '
    ConvertPixelsToPoints wVirtualScreenLeft, wVirtualScreenTop
    ConvertPixelsToPoints wVirtualScreenWidth, wVirtualScreenHeight

    Select Case pUserForm.StartupPosition
    Case StartupPosition.Manual, StartupPosition.WindowsDefault
        ' Do nothing
    Case StartupPosition.CenterOwner
        ' Position centered on top of the 'Owner'. Usually this is Application.
        '
        If Not pOwner Is Nothing Then Set pOwner = Application
        With pUserForm
            .StartupPosition = 0
            .Left = pOwner.Left + ((pOwner.Width - .Width) / 2)
            .Top = pOwner.Top + ((pOwner.Height - .Height) / 2)
        End With
        '
    Case StartupPosition.CenterScreen
        ' Assign the Left and Top properties after switching to Manual positioning.
        '
        With pUserForm
            .StartupPosition = StartupPosition.Manual
            .Left = (wVirtualScreenWidth - .Width) / 2
            .Top = (wVirtualScreenHeight - .Height) / 2
        End With
    End Select

    ' Avoid falling off screen. Misplacement can be caused by multiple screens when the primary display
    ' is not the left-most screen (which causes "pOwner.Left" to be negative). First make sure the bottom
    ' right fits, then check if the top-left is still on the screen (which gets priority).
    '
    With pUserForm
        If ((.Left + .Width) > (wVirtualScreenLeft + wVirtualScreenWidth)) _
        Then .Left = ((wVirtualScreenLeft + wVirtualScreenWidth) - .Width)
        If ((.Top + .Height) > (wVirtualScreenTop + wVirtualScreenHeight)) _
        Then .Top = ((wVirtualScreenTop + wVirtualScreenHeight) - .Height)
        If (.Left < wVirtualScreenLeft) Then .Left = wVirtualScreenLeft
        If (.Top < wVirtualScreenTop) Then .Top = wVirtualScreenTop
    End With
End Sub

' ------------------------------------------------------
' This function converts screen pixels (device dependent) to Points (used by Excel).
' ------------------------------------------------------
'
Public Sub ConvertPixelsToPoints(ByRef x As Single, ByRef y As Single)
On Error Resume Next
    Dim hDC            As Long
    Dim RetVal         As Long
    Dim PixelsPerInchX As Long
    Dim PixelsPerInchY As Long

    hDC = GetDC(0)
    PixelsPerInchX = GetDeviceCaps(hDC, LOGPIXELSX)
    PixelsPerInchY = GetDeviceCaps(hDC, LOGPIXELSY)
    RetVal = ReleaseDC(0, hDC)
    x = x * TWIPSPERINCH / 20 / PixelsPerInchX
    y = y * TWIPSPERINCH / 20 / PixelsPerInchY
End Sub

Put this in a the Userform’s code module:

Private Sub UserForm_Initialize()
    AdjustStartupPosition Me
End Sub

Dutch

Advertisements

14 Comments »

  1. It doesn’t work man…

    Comment by azrinsani — September 21, 2011 @ 3:24 am | Reply

  2. Ah… actually it does work… “Center Owner” works greatly
    Nice job!

    Comment by azrinsani — September 21, 2011 @ 3:35 am | Reply

  3. I had to comment lines 61 and 62 out. My third monitor is on the left of my primary monitor so it ends up having a negative left value. Other than that, this worked perfectly.

    Comment by Graham Merrill — June 7, 2013 @ 12:00 pm | Reply

    • That’s right, I also have a primary monitor that is not the one on the left. You can also use this to make it always work.

      Add these constants to make it all work:

      Public Const SM_XVIRTUALSCREEN As Long = &H4C&
      Public Const SM_YVIRTUALSCREEN As Long = &H4D&
      
          ' Avoid falling off screen. Misplacement can be caused by multiple screens when the primary display
          ' is not the left-most screen (which causes "pOwner.Left" to be negative).
          '
          With pUserForm
              If ((.Top + .Height) > wVirtualScreenHeight) Then .Top = (wVirtualScreenHeight - .Height)
              If ((.Left + .Width) > wVirtualScreenWidth) Then .Left = (wVirtualScreenWidth - .Width)
              If (.Top < GetSystemMetrics(SM_YVIRTUALSCREEN)) Then .Top = GetSystemMetrics(SM_YVIRTUALSCREEN)
              If (.Left < GetSystemMetrics(SM_XVIRTUALSCREEN)) Then .Left = GetSystemMetrics(SM_XVIRTUALSCREEN)
          End With
      

      Comment by dutchgemini — June 7, 2013 @ 1:05 pm | Reply

      • This improved things, but not in all cases. When the majority of the Excel window is out of view (e.g. too far on the left or right of the dual monitor setup), then the user form comes up outside the monitor boundaries. I’d expect it to always appear within the boundaries of the multi-monitor setup.

        Comment by The Dude — October 8, 2013 @ 6:46 pm

      • Thanks for pointing me on this problem. The above code does not take properly into account that the top-left coordinate of the virtual screen may not start at (0, 0) which is the case when the left-most screen is the primary one, but may be negative as is the case when the primary screen is one of the screens placed right. I’ll make the necessary adjustments and post-back the correct code.

        Comment by dutchgemini — October 9, 2013 @ 8:26 am

  4. is very good

    Comment by Kholilurrohman Uts — September 4, 2013 @ 2:24 pm | Reply

  5. Great stuff indeed.
    Does it come with any license? Is it OK to use in commercial projects?

    Small bug in AdjustStartupPosition
    If pOwner Is Nothing Then Set pOwner = Application

    Yiannis

    Comment by Yiannis Spyridakis — April 12, 2014 @ 9:44 pm | Reply

    • It comes with no restrictive license, it’s 100% free and you can use it in whatever project you want. If you like it you can always add a line in your code referring to me, and donate using PayPal.

      Comment by dutchgemini — April 14, 2014 @ 8:45 am | Reply

  6. Also, in order for the code to work on x64 office there’s only a few required changes:

    #If VBA7 Then
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
    #Else
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    #End If

    '...

    Public Sub ConvertPixelsToPoints(ByRef x As Single, ByRef y As Single)
    On Error Resume Next
    Dim hDC As LongPtr
    '...

    Comment by Yiannis Spyridakis — April 12, 2014 @ 9:50 pm | Reply

    • Thx. I don’t x64 yet as all my applications use many Microsoft Common Controls that are not available in x64 environment, and I don’t have time to develop them myself.

      Comment by dutchgemini — April 14, 2014 @ 8:48 am | Reply

  7. Wow. That’s impressive work. Not sure if this achieves the same results but this method works for me:

    With Application
    oForm.Left = .Left + .Width / 2 – oForm.Width / 2
    oForm.Top = .Top + .Height / 2 – oForm.Height / 2
    End With

    Comment by Craig Hatmaker — August 13, 2014 @ 12:29 pm | Reply

    • Confirmed. I used the code above but was forced to change after seeing that the form was not always following “the rules” and could eventually appear on a monitor different from the one showing Excel.

      Comment by dutchgemini — August 13, 2014 @ 5:06 pm | Reply

      • I had the same problem when using the ActiveWindow object, but since moving to the Application object I’ve not had that problem.

        Comment by Craig Hatmaker — August 13, 2014 @ 5:59 pm


RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Blog at WordPress.com.

%d bloggers like this: