How to center a UserForm in Visio?

Started by dirkasarus-rex, February 10, 2015, 08:57:29 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

dirkasarus-rex

In Excel's version of VBA, one centers a user form on the application window with this code:

------------------------------------------------------------------------------------------------
(In UserForm_Activate routine)
    UserForm1.Left = (Application.Width / 2) - (UserForm1.Width / 2)
    UserForm1.Top = (Application.Height / 2) - (UserForm1.Height / 2)
------------------------------------------------------------------------------------------------

However, Visio's version of VBA does not have Application.Width or .Height.

How do you center a UserForm on the drawing window in Visio?

Thanks!

Dirkasarus-Rex


JuneTheSecond

UserForm has StartUpPosition property.
you can set on property window, or
UserForm1.StartUpPosition=visCenter
Best Regards,

Junichi Yoda
http://june.minibird.jp/

daihashi

#2
Quote from: JuneTheSecond on February 11, 2015, 06:31:00 AM
UserForm has StartUpPosition property.
you can set on property window, or
UserForm1.StartUpPosition=visCenterhttp://visguy.com/vgforum/Themes/default/images/bbc/code.gif

It doesn't work if you have dual monitors; unlike excel and other office apps, the userforms in Visio don't center based on the position of the application window. Sometimes a person will get lucky, and the userform will center there, but if a person is using their 2nd monitor; or if the file was last saved on the secondary monitor, then it will likely appear off screen somewhere.

I use the following instead to get my forms to center... it actually doesn't center perfectly on the 2nd monitor, but it is pretty close. When I have time i'll go back and refine my formulas so that it centers perfectly. It took me quite a long time to find the API that would work in VBA to get me this level of detail so I could detect which monitor the application resided inside of:


  • First I put the following inside the userform that I wish to center:
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName _
                                                                      As String, ByVal lpWindowName As String) As Long

Private Const WS_CHILD = &H40000000
Private Const GWL_STYLE = (-16)
Private Const SW_SHOW = 5
Private Const SW_HIDE = 0

Option Explicit
Public display_ID As String
Private dcenter As CenterFORMS

Private Sub UserForm_Activate()
Dim hwndCustWin As Long

hwndCustWin = ActiveWindow.WindowHandle32
Set dcenter = New CenterFORMS
dcenter.hwnd = hwndCustWin
display_ID = Trim(dcenter.displayID)

Me.StartUpPosition = 0
Call Display_Center

End Sub

Sub Display_Center()
Dim xheight As Double
Dim xwidth As Double
Dim xpercentage As Double
Dim sysMetrics As New GetMonitorsDimensions
   
    xheight = sysMetrics.SystemMetrics(smScreenHeight)
    xwidth = sysMetrics.SystemMetrics(smScreenWidth)
    xpercentage = Me.Width / xwidth
   
        If Left(display_ID, 12) = "\\.\DISPLAY1" Then
            Me.Left = xwidth * sysMetrics.PointsPerPixelX / 2 - Me.Width / 2
        ElseIf Left(display_ID, 12) = "\\.\DISPLAY2" Then
            Me.Left = (xwidth * sysMetrics.PointsPerPixelX) / 2 + (Me.Width)
        End If

        Me.Top = xheight * sysMetrics.PointsPerPixely / 2 - Me.Height / 2
End Sub


  • Then I have the following inside of a Class module called "CenterFORMS"
Option Explicit

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction As Long, ByVal uiParam As Long, pvParam As Any, ByVal fWinIni As Long) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function MonitorFromWindow Lib "User32.dll" (ByVal hwnd As Long, ByVal dwFlags As Long) As Long  ' HMONITOR
Private Declare PtrSafe Function GetMonitorInfo Lib "User32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpMI As Any) As Long

Private Const SPI_GETWORKAREA As Long = 48
Private Const SM_CMONITORS As Long = 80

Private Const MONITORINFOF_PRIMARY As Long = 1
Private Const MONITOR_DEFAULTTONULL     As Long = 0
Private Const MONITOR_DEFAULTTOPRIMARY  As Long = 1
Private Const MONITOR_DEFAULTTONEAREST  As Long = 2

Private Const CCHDEVICENAME = 32

Private Const WM_WINDOWPOSCHANGING As Long = &H46
Private Const WM_WINDOWPOSCHANGED As Long = &H47

Private Type WINDOWPOS
   hwnd As Long
   hWndInsertAfter As Long
   x As Long
   y As Long
   cx As Long
   cy As Long
   flags As Long
End Type

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type MonitorInfo
   cbSize As Long
   rcMonitor As RECT
   rcWork As RECT
   dwFlags As Long
   szDevice As String * CCHDEVICENAME
End Type

Implements IHookSink


Private m_hWnd As Long
Private m_SnapGap As Long
Private mi As MonitorInfo


Private Const defSnapGap As Long = 15

Private Sub Class_Initialize()
   m_SnapGap = defSnapGap
End Sub

Private Sub Class_Terminate()
   If m_hWnd Then UnhookWindow (m_hWnd)
End Sub

Private Function IHookSink_WindowProc( _
   hwnd As Long, msg As Long, wp As Long, lp As Long) As Long
   Dim POS As WINDOWPOS

   Select Case msg
      Case WM_WINDOWPOSCHANGING
         Call CopyMemory(POS, ByVal lp, Len(POS))
         Call SnapToDesktopEdge(POS)
         Call CopyMemory(ByVal lp, POS, Len(POS))
         
      Case Else
         IHookSink_WindowProc = _
            InvokeWindowProc(hwnd, msg, wp, lp)
   End Select
End Function

Public Property Let hwnd(ByVal NewVal As Long)
Dim mon As RECT

   If m_hWnd Then
      Call UnhookWindow(m_hWnd)
   End If
   
   If IsWindow(NewVal) Then
      m_hWnd = NewVal
      'Call HookWindow(m_hWnd, Me)
      mon = GetWorkArea()
   End If
End Property

Public Property Get hwnd() As Long
   hwnd = m_hWnd
End Property

Public Property Let SnapGap(ByVal NewVal As Long)
   If NewVal > 0 Then m_SnapGap = NewVal
End Property

Public Property Get SnapGap() As Long
   SnapGap = m_SnapGap
End Property
Public Property Get displayID() As String
   displayID = mi.szDevice
End Property
Private Function GetWorkArea() As RECT
   Dim hMonitor As Long
   Call SystemParametersInfo(SPI_GETWORKAREA, 0&, GetWorkArea, 0&)

   If GetSystemMetrics(SM_CMONITORS) > 1 Then
      hMonitor = MonitorFromWindow(m_hWnd, MONITOR_DEFAULTTONEAREST)
      If hMonitor Then
         mi.cbSize = Len(mi)
         Call GetMonitorInfo(hMonitor, mi)
         GetWorkArea = mi.rcWork
      End If
   End If

Private Function GetWorkArea() As RECT
   Dim hMonitor As Long
   Call SystemParametersInfo(SPI_GETWORKAREA, 0&, GetWorkArea, 0&)

   If GetSystemMetrics(SM_CMONITORS) > 1 Then
      hMonitor = MonitorFromWindow(m_hWnd, MONITOR_DEFAULTTONEAREST)
      If hMonitor Then
         mi.cbSize = Len(mi)
         Call GetMonitorInfo(hMonitor, mi)
         GetWorkArea = mi.rcWork
      End If
   End If
End Function


dirkasarus-rex

Thank you for your thoughtful reply.  Most of the computers in my org are 64 bit at this point and your code is making reference to "user32" -- does this mean that it is not compatible with 64 bit systems?

Thank you again!

Nikolay

No it does not maen that. The code should run on 64 bits as well (microsoft did not rename dlls un x64)

also in visio you can just try application.window.width istead of application.width in excel.

daihashi

Quote from: Nikolay on February 27, 2015, 04:22:39 PM
No it does not maen that. The code should run on 64 bits as well (microsoft did not rename dlls un x64)

also in visio you can just try application.window.width istead of application.width in excel.

GRRR!! There seems to always be some simple solution I overlook. I'll give this a try and see if it will perfectly center things on the 2nd monitor. If so then this will be much nicer than my method.

Regarding 64bit vs 32 bit, Nikolay is correct; the only thing you need to account for in 64 bit office applications is to be sure to use "PtrSafe" in your function declarations.... which is already included in the sample code from my previous post.

daihashi

I know this is an old post, but I just got time to try the suggestion from Nikolay, and it seems that Application.Window.Width does not exist in visio vba.

Nikolay

Yep, my bad.
Not Application.Window.Width but Application.Window.GetWindowRect

daihashi

ahh; I don't know how I forgot about that. I use it for often to create anchored window panes.

I tried it for the use of centering userforms, and it works to some degree, but it's not consistent in the way I would like for userforms in a dual monitor configuration.

So instead I used some of my original code to get the active monitor that the Visio document is opened on; then made a second call using the EnumDisplayMonitors and GetMonitorInfo API to return information that I can then use to make centering user forms on the monitor window. This method is fairly full proof, and accounts for a number of unusual monitor configurations the end user may be using.

this is probably overkill, but I'm finding that people have very unusual monitor setups; such as:

  • laptop screen + monitor
  • monitors with different resolutions
  • monitor configurations where the left monitor is monitor 2, and right monitor is monitor 1 (and vice versa)
  • monitor configurations  that are set up for Right to left reading
  • monitor configurations where monitor 1 is the main display, or where monitor 2 is the main display.
  • and other miscellaneous configurations.

I've encountered all of these, with many complaints from users. Below is how I addressed it; very thorough, and likely not necessary for most people's needs. I could probably consolidate this code into a single class, but I've not gotten around to it yet.

The next post will have the code, and an explanation as well.

daihashi

Below is the userform activate event. It calls the CSnapDialog class that detects the active monitor, and retrieves the monitor's ID according to Microsoft Windows; after this is calls another routine within the userform that will begin the actual centering of the form. The code for the Userform.Display_Center routine will in the next post.


Private Sub UserForm_Activate()
Dim m_Snap As CSnapDialog

Set m_Snap = New CSnapDialog
display_ID = Trim(m_Snap.displayID)

Me.StartUpPosition = 0
Call Display_Center

End Sub


The code below is placed is some code by Karl Peterson that I've modified. I've placed it inside of a class that is named CSnapDialog; in retrospect this is best placed inside of a Module instead. If I had done that right off the bat, then I could use a single call to the GetMonitorInfo and EnumDisplayMonitors API's. The reason why is because these API's make use of "Address of"; which in VBA will only work in a .bas module.

The way I am using this is to retrieve the monitor that the application is opened on; the monitor ID is returned in a string format of "\\.\DISPLAY"<id>... where <id> is the Enumerated ID according to Microsoft Windows.


' *************************************************************************
'  Copyright ©2007-08 Karl E. Peterson
'  All Rights Reserved, http://vb.mvps.org/
' *************************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code, non-compiled, without prior written consent.
' *************************************************************************
Option Explicit

' Win32 API declarations
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction As Long, ByVal uiParam As Long, pvParam As Any, ByVal fWinIni As Long) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal dwFlags As Long) As Long  ' HMONITOR
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As Any) As Long

Private Const SPI_GETWORKAREA As Long = 48
Private Const SM_CMONITORS As Long = 80

Private Const MONITORINFOF_PRIMARY As Long = 1
Private Const MONITOR_DEFAULTTONULL     As Long = 0
Private Const MONITOR_DEFAULTTOPRIMARY  As Long = 1
Private Const MONITOR_DEFAULTTONEAREST  As Long = 2

Private Const CCHDEVICENAME = 32
' Watched messages
Private Const WM_WINDOWPOSCHANGING As Long = &H46
Private Const WM_WINDOWPOSCHANGED As Long = &H47

Private Type WINDOWPOS
   hwnd As Long
   hWndInsertAfter As Long
   x As Long
   y As Long
   cx As Long
   cy As Long
   flags As Long
End Type

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type MonitorInfo
   cbSize As Long
   rcMonitor As RECT
   rcWork As RECT
   dwFlags As Long
   szDevice As String * CCHDEVICENAME
End Type

Implements IHookSink

' Member variables
Private m_hWnd As Long
Private m_SnapGap As Long
Private mi As MonitorInfo

' Default values.
Private Const defSnapGap As Long = 15
'Dim mi As MonitorInfo

' **************************************************************
'  Initialization/Termination
' **************************************************************
Private Sub Class_Initialize()
         ' Set defaults
10       m_SnapGap = defSnapGap
End Sub

Private Sub Class_Terminate()
10       If m_hWnd Then UnhookWindow (m_hWnd)
End Sub

' **************************************************************
'  Hooking interface
' **************************************************************
Private Function IHookSink_WindowProc( _
   hwnd As Long, msg As Long, wp As Long, lp As Long) As Long
         Dim pos As WINDOWPOS
         ' Handle each message appropriately.
10       Select Case msg
            Case WM_WINDOWPOSCHANGING
               ' Snag copy of position structure, process it,
               ' and pass back to Windows any changes.
20             Call CopyMemory(pos, ByVal lp, Len(pos))
30             Call SnapToDesktopEdge(pos)
40             Call CopyMemory(ByVal lp, pos, Len(pos))
               
50          Case Else
               ' Just allow default processing for everything else.
60             IHookSink_WindowProc = _
                  InvokeWindowProc(hwnd, msg, wp, lp)
70       End Select
End Function

' **************************************************************
'  Public Properties
' **************************************************************
Public Property Let hwnd(ByVal NewVal As Long)
      Dim mon As RECT

         ' Unhook previous window if need be.
10       If m_hWnd Then
20          Call UnhookWindow(m_hWnd)
30       End If
         
         ' Store handle and hook new window.
40       If IsWindow(NewVal) Then
50          m_hWnd = NewVal
            'Call HookWindow(m_hWnd, Me)
60          mon = GetWorkArea()
            'MsgBox mi.szDevice
70       End If
End Property

Public Property Get hwnd() As Long
         ' Return handle for window we're monitoring.
10       hwnd = m_hWnd
End Property

Public Property Let SnapGap(ByVal NewVal As Long)
         ' Store tolerance for snapping to edge of screen.
10       If NewVal > 0 Then m_SnapGap = NewVal
End Property

Public Property Get SnapGap() As Long
         ' Return tolerance for snapping to edge of screen.
10       SnapGap = m_SnapGap
End Property
Public Property Get displayID() As String
         ' Return tolerance for snapping to edge of screen.
10       displayID = mi.szDevice
End Property
' **************************************************************
'  Private Methods
' **************************************************************
Private Sub SnapToDesktopEdge(pos As WINDOWPOS)
         Dim mon As RECT
         
         ' Get coordinates for main work area.
10       mon = GetWorkArea()
         
         ' Snap X axis
20       If Abs(pos.x - mon.Left) <= m_SnapGap Then
30          pos.x = mon.Left
40       ElseIf Abs(pos.x + pos.cx - mon.Right) <= m_SnapGap Then
50          pos.x = mon.Right - pos.cx
60       End If
         
         ' Snap Y axis
70       If Abs(pos.y - mon.Top) <= m_SnapGap Then
80          pos.y = mon.Top
90       ElseIf Abs(pos.y + pos.cy - mon.Bottom) <= m_SnapGap Then
100         pos.y = mon.Bottom - pos.cy
110      End If
End Sub

Private Function GetWorkArea() As RECT
         Dim hMonitor As Long
         'Dim mi As MonitorInfo

         ' Default to using traditional method, as fallback for cases where
         ' only one monitor is being used or new multimonitor method fails.
10       Call SystemParametersInfo(SPI_GETWORKAREA, 0&, GetWorkArea, 0&)

         ' Use newer multimonitor method to support cases of 2 or more.
20       If GetSystemMetrics(SM_CMONITORS) > 1 Then
            ' Get handle to monitor that has bulk of window within it.
30          hMonitor = MonitorFromWindow(m_hWnd, MONITOR_DEFAULTTONEAREST)
40          If hMonitor Then
50             mi.cbSize = Len(mi)
60             Call GetMonitorInfo(hMonitor, mi)
70             GetWorkArea = mi.rcWork
80          End If
90       End If
End Function



daihashi

Once the Display ID is retrieved, this is passed to another routine within the userform that I've named Display_Center. It makes a call to a module that I've placed a second instance of the previously mentioned API's that I use to retrieve the monitor details from. You can see I use the display ID to determine how to go about centering the form. This code will be pasted in sections so I can explain; and then I will post the module containing the API calls at the end.

In this snippet of code I create 3 variants; mon1_2ARR will be a container for the returned array from Module7.monPOS. Within that array are 2 more arrays (mon1ARR and mon2ARR); each containing monitor details for each monitor. The array for each monitor contains theses details in the following order: <is it the main display TRUE/FALSE>,<monitor .Left>,<monitor .Right>,<monitor .Bottom>,<monitor .Top>

The true* variables are used to calculate the actual right/bottom/top monitor resolution positions; I will explain this later.

Sub Display_Center()
    Dim mon1_2ARR As Variant, mon1ARR As Variant, mon2ARR As Variant
    Dim trueRIGHT As Integer, trueBOTTOM As Integer, trueTOP As Integer

        mon1_2ARR = Module7.monPOS
        mon1ARR = mon1_2ARR(0)
        mon2ARR = mon1_2ARR(1)


If the previously returned display ID is 1, then it checks to see if display 1 is also the primary monitor. If TRUE then it will set the userform.left = ((monitor#1.Left / 2)-(form.width / 2)) /2 and userform.Top = ((monitor.bottom / 2) - (form.Height / 2)) / 2. It then checks if Display #1 is the left monitor, or the right monitor
(Left monitor = If mon1ARR(1) = 0 Then If mon1ARR(2) > mon1ARR(1) Then)

    If Left(display_ID, 12) = "\\.\DISPLAY1" Then
        If mon1ARR(0) = True Then
            If mon1ARR(1) = 0 Then
                If mon1ARR(2) > mon1ARR(1) Then
                    Me.Left = ((mon1ARR(2) / 2) - (Me.Width / 2)) / 2
                Else
                    Me.Left = ((mon1ARR(1) / 2) - (Me.Width / 2)) / 2
                End If
               
                Me.Top = ((mon1ARR(3) / 2) - (Me.Height / 2)) / 2
            End If


If display ID 1 is not the primary monitor (ElseIf mon1ARR(0) = False And mon2ARR(0) = True Then), then things start to get messy. We now have to evaluate if both of the monitors are the same resolution or not. The reason is because the resolution details returned for the monitor will only return the resolution of the extended display for the .Left position, and the combined width for the .Right position.
Meaning, if you have a laptop screen as your primary with a resolution of 1366x768, and a secondary monitor with a res. of 1650x1050, then the .Left resolution for both monitors will be returned as 1366. However you can determine the true resolution of the extended display by subtracting the monitor1.Left from the monitor2.Right.

        ElseIf mon1ARR(0) = False And mon2ARR(0) = True Then
            If mon2ARR(1) = 0 Then
                If mon1ARR(2) > mon1ARR(1) And Not mon1ARR(1) < 0 Then
                    trueRIGHT = mon2ARR(2) + (mon1ARR(2) - mon1ARR(1))
                    Me.Left = (trueRIGHT - (Me.Width / 2)) / 2


In some monitor configurations, the resolution is actually returned as a negative value. So this has to be evaluated and adjusted for as well. In a similar way as I described for .Left

                ElseIf mon1ARR(1) < 0 And mon1ARR(2) = 0 Then
                        mon1ARR(1) = mon1ARR(1) * (-1)
                        trueRIGHT = (mon2ARR(2) + mon1ARR(1)) * (-1)
                        Me.Left = ((trueRIGHT / 2) - (Me.Width / 2)) / 2
                Else
                        Me.Left = (mon1ARR(1) - (Me.Width / 2)) / 2
                End If


In the scenario that display ID is not the primary monitor, then monitor.Bottom needs similar evaluation as what I just described above.
               
                If mon1ARR(4) > 0 Then
                    trueTOP = mon1ARR(3) - mon1ARR(4)
                    Me.Top = ((trueTOP / 2) - (Me.Height / 2))
                Else
                    Me.Top = ((mon1ARR(3) / 2) - (Me.Height / 2)) / 2
                End If
            End If
        End If



This section below is the same as what I described for the previous code snippet section, but if the displayID retrieved upon Userform_Activate = Display ID #2.
    ElseIf Left(display_ID, 12) = "\\.\DISPLAY2" Then
        If mon1ARR(0) = True Then
            If mon1ARR(1) = 0 Then
                If mon2ARR(2) > mon2ARR(1) Then
                    If mon2ARR(1) < 0 And mon2ARR(2) = 0 Then
                        mon2ARR(1) = mon2ARR(1) * (-1)
                        trueRIGHT = (mon1ARR(2) + mon2ARR(1)) * (-1)
                        Me.Left = ((trueRIGHT / 2) - (Me.Width / 2)) / 2
                    Else
                        trueRIGHT = mon1ARR(2) + (mon2ARR(2) - mon2ARR(1))
                        Me.Left = (trueRIGHT - (Me.Width / 2)) / 2
                    End If
   
                    If mon2ARR(4) < 0 Then
                        trueBOTTOM = mon2ARR(3) + (mon2ARR(4) * (-1))
                        Me.Top = ((trueBOTTOM / 2) - (Me.Height / 2)) / 2
                    Else
                        Me.Top = ((mon2ARR(3) / 2) - (Me.Height / 2)) / 2
                    End If
                ElseIf mon2ARR(1) > mon2ARR(2) Then
                    Me.Left = ((mon1ARR(2) + (mon2ARR(1) - mon2ARR(2))) - (Me.Width / 2)) / 2
                    Me.Top = ((mon2ARR(3) / 2) - (Me.Height / 2)) / 2
                End If
            ElseIf mon1ARR(1) > 0 Then
               
            End If
        ElseIf mon1ARR(0) = False And mon2ARR(0) = True Then
            Me.Left = ((mon2ARR(2) / 2) - (Me.Width / 2)) / 2
            Me.Top = ((mon2ARR(3) / 2) - (Me.Height / 2)) / 2
        End If
    End If
End Sub



daihashi

Below is the module I use to retrieve the details used for Userform.Display_Center. Private Function PrintMonitorInfo is where I pull the actual monitor details from.:

Option Explicit

Public Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Public Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Boolean

Public Const CCHDEVICENAME = 32
Public Const MONITORINFOF_PRIMARY = &H1

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type MONITORINFOEX
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
    szDevice As String * CCHDEVICENAME
End Type

Dim MonitorId() As String
Public Function monPOS() As Variant
' At the bottom I have pasted the results on my system.
Dim i As Integer
Dim monPOS1 As Variant, monPOS2 As Variant
    Debug.Print "Number of monitors in this system : " & GetMonitorId
    Debug.Print
    For i = 1 To UBound(MonitorId)
        If i = 1 Then
            monPOS1 = PrintMonitorInfo(MonitorId(i), i)
        ElseIf i = 2 Then
            monPOS2 = PrintMonitorInfo(MonitorId(i), i)
        End If
    Next i
    monPOS = Array(monPOS1, monPOS2)
End Function

Public Function GetMonitorId()
    ReDim MonitorId(0)
    ' Of course dual screen systems are not available on all Win versions.
    If FunctionExist("user32.dll", "EnumDisplayMonitors") = True Then
        If EnumDisplayMonitors(&H0, ByVal &H0, AddressOf MonitorEnumProc, &H0) = False Then
            Failed "EnumDisplayMonitors"
        End If
    End If
    GetMonitorId = UBound(MonitorId)
End Function


Private Function PrintMonitorInfo(ForMonitorID As String, ByVal i As Integer) As Variant
Dim MONITORINFOEX As MONITORINFOEX
Dim primaryDisplay As Boolean

    MONITORINFOEX.cbSize = Len(MONITORINFOEX)
    If GetMonitorInfo(CLng(ForMonitorID), MONITORINFOEX) = False Then Failed "GetMonitorInfo"
    With MONITORINFOEX
        If .dwFlags And MONITORINFOF_PRIMARY Then
            primaryDisplay = True
        Else
            primaryDisplay = False
        End If
        With .rcMonitor
            If i = 1 Then
                PrintMonitorInfo = Array(primaryDisplay, .Left, .Right, .Bottom, .Top)
            ElseIf i = 2 Then
                PrintMonitorInfo = Array(primaryDisplay, .Left, .Right, .Bottom, .Top)
            End If
        End With
    End With
End Function


Public Function FunctionExist(ByVal strModule As String, ByVal strFunction As String) As Boolean
Dim hHandle As Long
    hHandle = GetModuleHandle(strModule)
    If hHandle = &H0 Then
        Failed "GetModuleHandle"
        hHandle = LoadLibraryEx(strModule, &H0, &H0): If hHandle = &H0 Then Failed "LoadLibrary"
        If GetProcAddress(hHandle, strFunction) = &H0 Then
            Failed "GetProcAddress"
        Else
            FunctionExist = True
        End If
        If FreeLibrary(hHandle) = False Then Failed "FreeLibrary"
    Else
        If GetProcAddress(hHandle, strFunction) = &H0 Then
            Failed "GetProcAddress"
        Else
            FunctionExist = True
        End If
    End If
End Function


Public Sub Failed(ByVal strFunction As String)
    If errMsg = True Then
        If Err.LastDllError = 0 Then
            MessageBoxEx &H0, strFunction & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "Failed", "Error", MB_OK Or MB_ICONWARNING Or MB_SETFOREGROUND, 0
        Else
            Errors Err.LastDllError, strFunction
        End If
    End If
End Sub


Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
Dim ub As Integer
    ub = 0
    On Error Resume Next
    ub = UBound(MonitorId)
    On Error GoTo 0
    ReDim Preserve MonitorId(ub + 1)
    MonitorId(UBound(MonitorId)) = CStr(hMonitor)
    MonitorEnumProc = 1
End Function

daihashi

#12
There are other miscellaneous classes, and 1 other module used, but rather than explain them I will simply attach a working version of the code I described above.

If you really want to see this shine then change resolutions, use different types of monitors, change primary/secondary displays, change the order of your displays, and try using your laptop screen in combination with a secondary full size monitor.

This handles all kinds of situations that may be encountered by users. Although you can work with Application.GetWindowRect to get things close, it takes some work and does not work as well as code I've attached here.

Feel free to use as you wish; simply copy the modules/classes to your project, and make use of the code in the Userform within your own forms. Enjoy.