Access VBA如何实现弹窗移动到当前所在显示器的左上角？

你遇到的问题是Access原生的DoCmd.MoveSize和表单Move方法默认使用主显示器坐标系/相对Access主窗口坐标，不属于Access VBA的固有局限，通过调用Windows系统API即可实现需求。

1. 前置API声明 #

将以下代码放在VBA普通模块的顶部，可同时兼容32位/64位版本Office：

Option Compare Database
Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr
    Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, lpmi As MONITORINFO) As Long
    Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    Type MONITORINFO
        cbSize As Long
        rcMonitor As RECT
        rcWork As RECT
        dwFlags As Long
    End Type
    Const MONITOR_DEFAULTTONEAREST As Long = &H2
#Else
    Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Declare Function MonitorFromWindow Lib "user32" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
    Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, lpmi As MONITORINFO) As Long
    Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    Type MONITORINFO
        cbSize As Long
        rcMonitor As RECT
        rcWork As RECT
        dwFlags As Long
    End Type
    Const MONITOR_DEFAULTTONEAREST As Long = &H2
#End If

2. 封装移动逻辑函数 #

在同一模块中添加通用移动函数：

Sub MoveFormToCurrentMonitorTopLeft(frm As Form)
    Dim hWnd As LongPtr
    Dim hMonitor As LongPtr
    Dim mi As MONITORINFO
    
    ' 获取当前表单的窗口句柄
    hWnd = frm.hWnd
    ' 获取表单当前所在的显示器句柄
    hMonitor = MonitorFromWindow(hWnd, MONITOR_DEFAULTTONEAREST)
    
    ' 读取显示器的坐标信息
    mi.cbSize = Len(mi)
    GetMonitorInfo hMonitor, mi
    
    ' Access表单Move方法使用缇作为单位，96DPI下1像素=15缇，转换后执行移动
    ' 若要移动到排除任务栏的工作区左上角，将rcMonitor替换为rcWork即可
    frm.Move mi.rcMonitor.Left * 15, mi.rcMonitor.Top * 15
End Sub

3. 按钮点击事件调用 #

替换你原有的按钮点击代码：

Private Sub Command1_Click()
    Call MoveFormToCurrentMonitorTopLeft(Me)
End Sub

补充说明 #

如果设备使用非常规高DPI缩放，可额外调用GetDpiForWindowAPI获取当前窗口的DPI值，替换固定系数15做单位转换即可适配所有缩放场景。

内容的提问来源于stack exchange，提问作者George Smith