Module for repositioning windows in Access using Window API calls

Module.vbs

Option Compare Database
Option Explicit

Private Type Point
    x As Long
    y As Long
End Type

Private Type Position
    left As Long
    top As Long
    width As Long
    height As Long
End Type

Private Type Dimensions
    width As Long
    height As Long
End Type

Private Type Rect
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
End Type

Public Enum Dimension
    DIMENSION_X = 1
    DIMENSION_Y = 2
End Enum

' VBA (or possibly just the editor) is stupid and doesn't handle hex literals correctly
' Luckily it doesn't seem to be able to cope with x64 so for now we can get away with decimals
Public Enum PositionMode
    DISPLAY_LEFT = -2013265920     ' 0x88000000
    DISPLAY_RIGHT = -2080374784    ' 0x84000000
    DISPLAY_X_CENTER = -2113929216 ' 0x82000000
    DISPLAY_TOP = 34816            ' 0x00008800
    DISPLAY_BOTTOM = 33792         ' 0x00008400
    DISPLAY_Y_CENTER = 33280       ' 0x00008200
    
    WINDOW_LEFT = 1207959552       ' 0x48000000
    WINDOW_RIGHT = 1140850688      ' 0x44000000
    WINDOW_X_CENTER = 1107296256   ' 0x42000000
    WINDOW_TOP = 18432             ' 0x00004800
    WINDOW_BOTTOM = 17408          ' 0x00004400
    WINDOW_Y_CENTER = 16896        ' 0x00004200
    
    CURSOR_LEFT = 671088640        ' 0x28000000
    CURSOR_RIGHT = 603979776       ' 0x24000000
    CURSOR_X_CENTER = 570425344    ' 0x22000000
    CURSOR_TOP = 10240             ' 0x00002800
    CURSOR_BOTTOM = 9216           ' 0x00002400
    CURSOR_Y_CENTER = 8704         ' 0x00002200
    
    PREVENT_OVERFLOW_X = 16777216  ' 0x01000000
    PREVENT_OVERFLOW_Y = 256       ' 0x00000100
    PREVENT_OVERFLOW = 16777472    ' 0x01000100
End Enum

Private Enum PositionModeMeta
    DISPLAY_X = -2147483648# ' 0x80000000
    WINDOW_X = 1073741824    ' 0x40000000
    CURSOR_X = 536870912     ' 0x20000000
    DISPLAY_Y = 32768        ' 0x00008000
    WINDOW_Y = 16384         ' 0x00004000
    CURSOR_Y = 8192          ' 0x00002000
    LEFT_X = 134217728       ' 0x08000000
    RIGHT_X = 67108864       ' 0x04000000
    CENTER_X = 33554432      ' 0x02000000
    TOP_Y = 2048             ' 0x00000800
    BOTTOM_Y = 1024          ' 0x00000400
    CENTER_Y = 512           ' 0x00000200
    
    BASE_X = -536870912      ' 0xE0000000
    BASE_Y = 57344           ' 0x0000E000
    LOCATION_X = 234881024   ' 0x0E000000
    LOCATION_Y = 2584        ' 0x00000E00
End Enum

' Some constants from the windows API (with more sensible names)
Private Const RESOLUTION_X = 8
Private Const RESOLUTION_Y = 10
Private Const DPI_X = 88
Private Const DPI_Y = 90
Private Const VIRTUALDISPLAY_LEFT = 76
Private Const VIRTUALDISPLAY_TOP = 77
Private Const VIRTUALDISPLAY_WIDTH = 78
Private Const VIRTUALDISPLAY_HEIGHT = 79

' Import some calls from the windows API
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal W As Long, ByVal H As Long, ByVal Repaint As Boolean) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

' Get the current co-ordinate of the mouse pointer
Private Function GetCursorPoint() As Point

    Dim udtMousePointer As Point
    GetCursorPos udtMousePointer
    GetCursorPoint = udtMousePointer

End Function

' Get the DPI setting for the desktop
Private Function GetDPI() As Point

    Dim intWindow As Long, _
        intContext As Long

    intWindow = GetDesktopWindow()
    intContext = GetDC(intWindow)

    GetDPI.x = GetDeviceCaps(intContext, DPI_X)
    GetDPI.y = GetDeviceCaps(intContext, DPI_Y)

    ReleaseDC intWindow, intContext

End Function

' Get the resolution of the the primary display
Private Function GetResolution() As Dimensions

    Dim intWindow As Long, _
        intContext As Long

    intWindow = GetDesktopWindow()
    intContext = GetDC(intWindow)

    GetResolution.width = GetDeviceCaps(intContext, RESOLUTION_X)
    GetResolution.height = GetDeviceCaps(intContext, RESOLUTION_Y)

    ReleaseDC intWindow, intContext

End Function

' Get the number of twips per pixel with the current settings of the primary display
Private Function GetTwipsPerPixel(Optional Dimension As Dimension = DIMENSION_X) As Double

    Dim udtPrimaryDisplayResolution As Dimensions, _
        udtDPI As Point

    udtPrimaryDisplayResolution = GetResolution()
    udtDPI = GetDPI()

    If Dimension = DIMENSION_Y Then
        GetTwipsPerPixel = ((udtPrimaryDisplayResolution.height / udtDPI.y) * 1440) / udtPrimaryDisplayResolution.height
    Else
        GetTwipsPerPixel = ((udtPrimaryDisplayResolution.width / udtDPI.x) * 1440) / udtPrimaryDisplayResolution.width
    End If

End Function

' Get a Position structure describing the supplied window handle
Private Function GetWindowPosition(hWnd As Long) As Position

    Dim udtRect As Rect
    GetWindowRect hWnd, udtRect

    GetWindowPosition.left = udtRect.x1
    GetWindowPosition.top = udtRect.y1
    GetWindowPosition.width = udtRect.x2 - udtRect.x1
    GetWindowPosition.height = udtRect.y2 - udtRect.y1

End Function

' Get a Dimensions structure describing the supplied window handle
Private Function GetWindowDimensions(hWnd As Long) As Dimensions

    Dim udtRect As Rect
    GetWindowRect hWnd, udtRect

    GetWindowDimensions.width = udtRect.x2 - udtRect.x1
    GetWindowDimensions.height = udtRect.y2 - udtRect.y1

End Function

' Convert the specified number of pixels to twips
Public Function PixelsToTwips(Pixels As Long, Optional Dimension As Dimension = DIMENSION_X) As Long

    PixelsToTwips = CLng(Pixels * GetTwipsPerPixel(Dimension))

End Function

' Convert the specified number of twips to pixels
Public Function TwipsToPixels(Twips As Long, Optional Dimension As Dimension = DIMENSION_X) As Long

    TwipsToPixels = CLng(Twips / GetTwipsPerPixel(Dimension))

End Function

Public Function PositionWindow(hWnd As Long, Mode As PositionMode, Optional OffsetX As Long = 0, Optional OffsetY As Long = 0)

    Dim udtTargetWindowDimensions As Dimensions, _
        udtPrimaryDisplayResolution As Dimensions, _
        udtAccessWindowPosition As Position, _
        udtVirtualDisplayPosition As Position, _
        udtMousePointer As Point, _
        intActiveDisplayLeft As Long, _
        intActiveDisplayTop As Long, _
        intFormLeft As Long, _
        intFormTop As Long

    ' Validate mode mask
    If (Mode And PositionModeMeta.BASE_X) = 0 Or (Mode And PositionModeMeta.BASE_Y) = 0 Or (Mode And PositionModeMeta.LOCATION_X) = 0 Or (Mode And PositionModeMeta.LOCATION_Y) = 0 Then
        Err.Raise 1, "GUI.PositionWindow()", "Invalid mode mask, must contain base and location for X and Y axes"
    End If

    ' Get some info about the current state of the desktop environment and the windows we're interested in
    udtTargetWindowDimensions = GetWindowDimensions(hWnd)
    udtPrimaryDisplayResolution = GetResolution()
    udtAccessWindowPosition = GetWindowPosition(Application.hWndAccessApp)
    udtMousePointer = GetCursorPoint()
    udtVirtualDisplayPosition.left = GetSystemMetrics(VIRTUALDISPLAY_LEFT)
    udtVirtualDisplayPosition.top = GetSystemMetrics(VIRTUALDISPLAY_TOP)
    udtVirtualDisplayPosition.width = GetSystemMetrics(VIRTUALDISPLAY_WIDTH)
    udtVirtualDisplayPosition.height = GetSystemMetrics(VIRTUALDISPLAY_HEIGHT)

    ' Find the X co-ordinate of the left-most pixel column on the target display
    intActiveDisplayLeft = udtPrimaryDisplayResolution.width * (Math.Ceil(((udtAccessWindowPosition.width / 2) + udtAccessWindowPosition.left) / udtPrimaryDisplayResolution.width) - 1)
    If intActiveDisplayLeft < udtVirtualDisplayPosition.left Then
        intActiveDisplayLeft = udtVirtualDisplayPosition.left
    ElseIf intActiveDisplayLeft >= udtVirtualDisplayPosition.left + udtVirtualDisplayPosition.width Then
        intActiveDisplayLeft = udtVirtualDisplayPosition.width - udtPrimaryDisplayResolution.width
    End If

    ' Find the Y co-ordinate of the top-most pixel row on the target display
    intActiveDisplayTop = udtPrimaryDisplayResolution.height * (Math.Ceil(((udtAccessWindowPosition.height / 2) + udtAccessWindowPosition.top) / udtPrimaryDisplayResolution.height) - 1)
    If intActiveDisplayTop < udtVirtualDisplayPosition.top Then
        intActiveDisplayTop = udtVirtualDisplayPosition.top
    ElseIf intActiveDisplayTop >= udtVirtualDisplayPosition.top + udtVirtualDisplayPosition.height Then
        intActiveDisplayTop = udtVirtualDisplayPosition.height - udtPrimaryDisplayResolution.height
    End If

    ' Find the desired X co-ordinate for the target window
    If (Mode And PositionModeMeta.DISPLAY_X) = PositionModeMeta.DISPLAY_X Then
        If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then
            intFormLeft = intActiveDisplayLeft + IIf(OffsetX <> 0, OffsetX, 1)
        ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then
            intFormLeft = intActiveDisplayLeft + (udtPrimaryDisplayResolution.width - udtTargetWindowDimensions.width) + IIf(OffsetX <> 0, OffsetX, -1)
        ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then
            intFormLeft = intActiveDisplayLeft + OffsetX + (udtPrimaryDisplayResolution.width / 2) - (udtTargetWindowDimensions.width / 2)
        End If
    Else
        If (Mode And PositionModeMeta.WINDOW_X) = PositionModeMeta.WINDOW_X Then
            If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then
                intFormLeft = udtAccessWindowPosition.left + IIf(OffsetX <> 0, OffsetX, 1)
            ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then
                intFormLeft = udtAccessWindowPosition.left + (udtAccessWindowPosition.width - udtTargetWindowDimensions.width) + IIf(OffsetX <> 0, OffsetX, -1)
            ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then
                intFormLeft = udtAccessWindowPosition.left + OffsetX + (udtAccessWindowPosition.width / 2) - (udtTargetWindowDimensions.width / 2)
            End If
        ElseIf (Mode And PositionModeMeta.CURSOR_X) = PositionModeMeta.CURSOR_X Then
            If (Mode And PositionModeMeta.LEFT_X) = PositionModeMeta.LEFT_X Then
                intFormLeft = udtMousePointer.x + OffsetX - udtTargetWindowDimensions.width
            ElseIf (Mode And PositionModeMeta.RIGHT_X) = PositionModeMeta.RIGHT_X Then
                intFormLeft = udtMousePointer.x + OffsetX
            ElseIf (Mode And PositionModeMeta.CENTER_X) = PositionModeMeta.CENTER_X Then
                intFormLeft = udtMousePointer.x + OffsetX - (udtTargetWindowDimensions.width / 2)
            End If
        End If

        ' Correct horizontal overflow off the target display
        If (Mode And PositionMode.PREVENT_OVERFLOW_X) = PositionMode.PREVENT_OVERFLOW_X Then
            If intFormLeft < intActiveDisplayLeft Then
                intFormLeft = intActiveDisplayLeft + 1
            ElseIf intFormLeft >= intActiveDisplayLeft + udtPrimaryDisplayResolution.width - (udtTargetWindowDimensions.width + 1) Then
                intFormLeft = intActiveDisplayLeft + udtPrimaryDisplayResolution.width - (udtTargetWindowDimensions.width + 1)
            End If
        End If
    End If

    ' Find the desired Y co-ordinate for the target window
    If (Mode And PositionModeMeta.DISPLAY_Y) = PositionModeMeta.DISPLAY_Y Then
        If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then
            intFormTop = intActiveDisplayTop + IIf(OffsetY <> 0, OffsetY, 1)
        ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then
            intFormTop = intActiveDisplayTop + (udtPrimaryDisplayResolution.height - udtTargetWindowDimensions.height) + IIf(OffsetY <> 0, OffsetY, -1)
        ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then
            intFormTop = intActiveDisplayTop + OffsetY + (udtPrimaryDisplayResolution.height / 2) - (udtTargetWindowDimensions.height / 2)
        End If
    Else
        If (Mode And PositionModeMeta.WINDOW_Y) = PositionModeMeta.WINDOW_Y Then
            If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then
                intFormTop = udtAccessWindowPosition.top + IIf(OffsetY <> 0, OffsetY, 1)
            ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then
                intFormTop = udtAccessWindowPosition.top + (udtAccessWindowPosition.height - udtTargetWindowDimensions.height) + IIf(OffsetY <> 0, OffsetY, -1)
            ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then
                intFormTop = udtAccessWindowPosition.top + OffsetY + (udtAccessWindowPosition.height / 2) - (udtTargetWindowDimensions.height / 2)
            End If
        ElseIf (Mode And PositionModeMeta.CURSOR_Y) = PositionModeMeta.CURSOR_Y Then
            If (Mode And PositionModeMeta.TOP_Y) = PositionModeMeta.TOP_Y Then
                intFormTop = udtMousePointer.y + OffsetY - udtTargetWindowDimensions.height
            ElseIf (Mode And PositionModeMeta.BOTTOM_Y) = PositionModeMeta.BOTTOM_Y Then
                intFormTop = udtMousePointer.y + OffsetY
            ElseIf (Mode And PositionModeMeta.CENTER_Y) = PositionModeMeta.CENTER_Y Then
                intFormTop = udtMousePointer.y + OffsetY - (udtTargetWindowDimensions.height / 2)
            End If
        End If

        ' Correct vertical overflow off the target display
        If (Mode And PositionMode.PREVENT_OVERFLOW_Y) = PositionMode.PREVENT_OVERFLOW_Y Then
            If intFormTop < intActiveDisplayTop Then
                intFormTop = intActiveDisplayTop + 1
            ElseIf intFormTop >= intActiveDisplayTop + udtPrimaryDisplayResolution.height - (udtTargetWindowDimensions.height + 1) Then
                intFormTop = intActiveDisplayTop + udtPrimaryDisplayResolution.height - (udtTargetWindowDimensions.height + 1)
            End If
        End If
    End If

    ' Move the window to the calculated position
    MoveWindow hWnd, intFormLeft, intFormTop, udtTargetWindowDimensions.width, udtTargetWindowDimensions.height, True

End Function

Hi @DittoBird, in order for the code to function as designed, @lars49's function needs to be placed in a separate module named "Math". You can also simply place the function into the same module as this code, and remove Math. from the function reference.

Apologies for publishing broken code, I haven't touched Access for a few years but this code came from a wider ecosystem with a few "standard" modules, where I basically wrote a few shims to make VBA behave a bit more like VB.net/C#/JS/Java/a generally saner programming language :-P