Positioning popup forms in relation to the main MS Access window on multiple monitors

Nick67
CERTIFIED EXPERT
Published:
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open on the left monitor, and the main application window open on the right monitor, and you now open the app on a single monitor machine, the resulting popup form will be 'smushed' to a width of zero--and therefore be invisible

What to do?

Well, you can first put some code in the Form_Open event to move the form to the upper left (some arbitrary position (0,0) ) of the work area and set a minimum size to get around any 'smushing'

Private Sub Form_Open(Cancel As Integer)
                      
                      With DoCmd
                          .SelectObject acForm, "myformname"
                          .MoveSize 0, 0
                      End With
                      
                      Me.Width = 6.5 * 1440 '6.5 inches wide for the window
                      Me.InsideHeight = 2.125 * 1440 '2.125 inches high for the window working area
                      Me.InsideWidth = 6.25 * 1440 '6.25 inches wide for the window working area
                      
                      end sub

Open in new window


Which is okay as far as it goes.  But what if the boss has a triple monitor setup, and opens the app on the right-hand monitor.  Then that popup form goes waaaaaaaaaaaay left,  which is annoying.  Ideally, you'd like to be able to position the popup form in relation to the main application window.  But how?

Enter some Windows API code!
Put this snippet in a code module

Option Compare Database
                      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 Declare Function MonitorFromWindow Lib "User32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
                       
                      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
                      
                       
                      Private Function PrintMonitorInfo(ForMonitorID As String) As Long
                      Dim MONITORINFOEX As MONITORINFOEX
                      Dim info As String
                          MONITORINFOEX.cbSize = Len(MONITORINFOEX)
                          If GetMonitorInfo(CLng(ForMonitorID), MONITORINFOEX) = False Then Exit Function 'Failed "GetMonitorInfo"
                          With MONITORINFOEX
                              With .rcWork
                                  PrintMonitorInfo = .Left
                              End With
                          End With
                      End Function
                       
                      
                      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
                      
                       
                      Public Function AppLeft() As Long
                      Dim hMonitor As String
                      Dim i As Integer
                      hMonitor = MonitorFromWindow(Application.hWndAccessApp, &H0&)
                      AppLeft = PrintMonitorInfo(hMonitor)
                      End Function

Open in new window


Now, I don't pretend to understand all the ins-and-outs of API code but, what AppLeft()  does is return how many pixels the main app window is from the left edge of the working space.  From there a little math -- 96 pixels per inch and 1440 twips per inch--and you can get that wayward puppy of a popup form to open where YOU want it to open with your movesize command.

Alter that Form_Open code a little

Private Sub Form_Open(Cancel As Integer)
                      Dim LeftPosition As Single
                      LeftPosition = AppLeft() / 96 * 1440
                      
                      With DoCmd
                          .SelectObject acForm, "myformname"
                          .MoveSize LeftPosition, 0
                      End With
                      
                      Me.Width = 6.5 * 1440 '6.5 inches wide for the window
                      Me.InsideHeight = 2.125 * 1440 '2.125 inches high for the window working area
                      Me.InsideWidth = 6.25 * 1440 '6.25 inches wide for the window working area
                      
                      end sub

Open in new window


and you are in business! Almost...
It turns out that twips are limited to the maximum value of an integer, ~32000.  Things start going BANG! between 31650 and 31700.  It turns out that .Move will move things relative to the very thing my API code was meant to discover--the left edge of the main application window.  The twips limit still applies, though.

So for what I wanted, I could have just issued this code
Private Sub Form_Open(Cancel As Integer)
                      
                      With  Me
                          .Move 0, 0
                          .Width = 6.5 * 1440 '6.5 inches wide for the window
                          .InsideHeight = 2.125 * 1440 '2.125 inches high for the window working area
                          .InsideWidth = 6.25 * 1440 '6.25 inches wide for the window working area
                      End with
                      
                      end sub

Open in new window



And been done.  If your positioning needs are more complex, what I have documented may still be quite useful to you.   You can move ~32000 twips from the left edge and top with .MoveSize or +/_ ~32000 twips from the left edge of the main app window with .Move

That's a fair bit of real estate, around 22."  Given the boss's 3 x 24" monitors, I should be able to make it work!
6
23,537 Views
Nick67
CERTIFIED EXPERT

Comments (0)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.