Fun with Form Windows
Using my FillAccessWindow function to resize Form and Report objects relative to the amount of available space on the Access canvas.
Several versions back, Microsoft Access introduced a feature that supports tabbed interfaces where every form, datasheet, and report are opened full-screen. I have to confess, I never spent a lot of time with that feature, so I may be missing out. But, if you still use the "old school" windowed forms like me, then boy have I got a treat for you today.
I wrote a function named FillAccessWindow that resizes Form and Report objects relative to the amount of available space on the Access canvas. Allow me to demonstrate.
Default form opening behavior
The form opens at the same size and location (relative to the upper left corner of the screen) as the last time it was saved in Design View. If the form is too big to fit on the canvas, the Access window gets scrollbars and you have to scroll the window to see the form.
DoCmd.OpenForm "Form1"
Forcing a form to Maximized after opening
I used to force reports to Maximized when I opened them in preview mode. The problem came when the user closed the report. The form that received the focus after a maximized report closed became maximized itself. This was not usually what I wanted. To work around this behavior, I would save the state of the form prior to opening the report. Then, when the user closed the maximized report, I would restore the form to whatever its original state was. This worked well most of the time, but it was never perfect.
DoCmd.OpenForm "Form1": DoCmd.Maximize
Filling the available space without maximizing the form
This is what I do now when I preview reports. Rather than maximizing the report itself, I simply resize it to fill the available space. I'm using forms for all the screenshots in this article, but the function works the same with reports.
'Fill the available space without maximizing
DoCmd.OpenForm "Form1":FillAccessWindow
Why stop there?
Once I had worked out all the necessary API calls to achieve the above behavior, I realized I could support a bunch of extra functionality without much more work. For example, what if we had four forms (or reports) that we wanted to display at the same time?
'Divide the canvas into quadrants; populate clockwise
DoCmd.OpenForm "Form1":FillAccessWindow , ,"NW", .5, .5
DoCmd.OpenForm "Form2":FillAccessWindow , ,"NE", .5, .5
DoCmd.OpenForm "Form3":FillAccessWindow , ,"SE", .5, .5
DoCmd.OpenForm "Form4":FillAccessWindow , ,"SW", .5, .5
How about a sidebar?
'Create a sidebar with stacked forms in the remaining space
DoCmd.OpenForm "Form1":FillAccessWindow , ,"NW", 1, .4
DoCmd.OpenForm "Form2":FillAccessWindow , ,"NE", .5, .6
DoCmd.OpenForm "Form3":FillAccessWindow , ,"SE", .5, .6
Filling available space while maintaining an aspect ratio
'Fill the available space but maintain a specific aspect ratio
'1:1 aspect ratio (i.e., square)
DoCmd.OpenForm "Form1":FillAccessWindow , 1, "Center"
'1:2 (height to width; landscape)
DoCmd.OpenForm "Form2":FillAccessWindow , .5, "Center"
'7:4 (height to width; portrait)
DoCmd.OpenForm "Form3":FillAccessWindow , 1.75, "Center" 
The Code
Without further ado, here is the code. This is pretty rock solid code, but you should always save and backup your work before running Windows API calls for the first time. If you get something wrong when using an API call, there is a good chance Access will hard-crash without giving you a chance to save your work first.
Also, there is no error handling in these routines. That's because I use vbWatchdog. You should, too. But if you don't, you'll probably want to add error handling to the routines that need it.
Option Compare Database
Option Explicit
Private Type rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As LongPtr, _
ByVal X As Long, ByVal Y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
#Else
Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As LongPtr, lpRect As rect) As Long
#Else
Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As Long, lpRect As rect) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function apiFindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
#Else
Private Declare Function apiFindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function apiGetParent Lib "user32" _
Alias "GetParent" _
(ByVal hWnd As LongPtr) _
As LongPtr
#Else
Private Declare Function apiGetParent Lib "user32" _
Alias "GetParent" _
(ByVal hWnd As Long) _
As Long
#End If
'----------------------------------------------------
' Procedure : FillAccessWindow
' Author : Mike Wolfe <mike@nolongerset.com>
'
'Used to set the window size of an Access form or report
'Usage A: Fill the available screen space
' FillAccessWindow Frm.Hwnd
'
'Usage B: Maximize the form or report while maintaining a given ratio (a square in this example)
' FillAccessWindow Frm.Hwnd, 1
'
'Usage C: A tall window anchored to the upper right corner of available space
' FillAccessWindow Frm.Hwnd, 2.5, "NE"
'
'Usage D: Arrange four forms to fill the corners of the available space
' FillAccessWindow FrmA.Hwnd, , "NW", 0.5, 0.5
' FillAccessWindow FrmB.Hwnd, , "NE", 0.5, 0.5
' FillAccessWindow FrmC.Hwnd, , "SE", 0.5, 0.5
' FillAccessWindow FrmD.Hwnd, , "SW", 0.5, 0.5
'
Sub FillAccessWindow(Optional ChildHWnd As Long, _
Optional HtToWdRatio As Double = 0, _
Optional AnchorLoc As String = "NW", _
Optional HeightToCanvasRatio As Double = 1, _
Optional WidthToCanvasRatio As Double = 1)
Dim hWnd As Long, Canvas As rect
hWnd = GetHWnd(ChildHWnd)
Canvas = GetCanvas(hWnd)
Dim wd As Long, ht As Long
wd = (Canvas.Right - Canvas.Left) * WidthToCanvasRatio
ht = (Canvas.Bottom - Canvas.Top) * HeightToCanvasRatio
'Handle the case where we want to maintain a specific Height-to-Width ratio
If HtToWdRatio <> 0 Then
Dim CanvasHtToWdRatio As Double
CanvasHtToWdRatio = (Canvas.Bottom - Canvas.Top) / (Canvas.Right - Canvas.Left)
If CanvasHtToWdRatio > HtToWdRatio Then
ht = wd * HtToWdRatio
Else
wd = ht / HtToWdRatio
End If
End If
'Move and resize the window
Select Case AnchorLoc
Case "Center"
apiMoveWindow hWnd, (Canvas.Right - wd) / 2, (Canvas.Bottom - ht) / 2, wd, ht, True
Case "NE"
apiMoveWindow hWnd, Canvas.Right - wd, 0, wd, ht, True
Case "SE"
apiMoveWindow hWnd, Canvas.Right - wd, Canvas.Bottom - ht, wd, ht, True
Case "SW"
apiMoveWindow hWnd, 0, Canvas.Bottom - ht, wd, ht, True
Case Else '"NW"
apiMoveWindow hWnd, 0, 0, wd, ht, True
End Select
End Sub
'Returns HWnd if <> 0, else the window handle of the active on-screen object
Private Function GetHWnd(hWnd As Long) As Long
On Error Resume Next
GetHWnd = hWnd
If GetHWnd = 0 Then GetHWnd = Screen.ActiveForm.hWnd
If GetHWnd = 0 Then GetHWnd = Screen.ActiveReport.hWnd
If GetHWnd = 0 Then GetHWnd = Screen.ActiveDatasheet.hWnd
End Function
Function GetCanvas(Optional ByVal ChildHWnd As Long) As rect
Dim CanvasHwnd As Long
CanvasHwnd = GetInnerAccessHwnd(ChildHWnd)
apiGetClientRect CanvasHwnd, GetCanvas
End Function
'---------------------------------------------------------------------------------------
' Procedure : GetInnerAccessHwnd
' Author : Mike Wolfe
' Date : 11/26/2014
' Purpose : Gets the window handle of the Access "canvas".
' Notes - We don't use HWndAccessApp here because that's the window handle for the
' full application; what we really want is the handle for the "inner container";
' ie, the Access window minus the docked menus, docked toolbars, and status bar
'---------------------------------------------------------------------------------------
'
Function GetInnerAccessHwnd(Optional ByVal ChildHWnd As Long = 0) As Variant 'Variant used instead of Conditional Compile (Long needed for 32bit LongPtr needed for 64bit)
GetInnerAccessHwnd = apiFindWindowEx(hWndAccessApp, ByVal 0&, "MDIClient", vbNullString)
If GetInnerAccessHwnd <> 0 Then Exit Function
On Error Resume Next
If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveForm.hWnd
If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveReport.hWnd
If ChildHWnd = 0 Then ChildHWnd = Screen.ActiveDatasheet.hWnd
GetInnerAccessHwnd = apiGetParent(ChildHWnd)
End Function
Image by Free-Photos from Pixabay
