如何修复64位VBA7.1中EnumDisplayMonitors的类型不匹配错误

出现Compile error: Type-mismatch for the part AddressOf MonitorEnumProc错误的核心原因是：32位VBA编写的代码未适配64位环境的指针/句柄类型，导致回调函数签名与API要求不匹配。以下是具体修复步骤和完整代码：

关键修复点 #

• 所有Windows API声明必须添加PtrSafe关键字，适配64位内存地址长度
• 句柄类型（如hMonitor、hdc）替换为LongPtr（64位下为8字节，32位下自动转为4字节，实现跨版本兼容）
• 回调函数MonitorEnumProc的参数类型必须与EnumDisplayMonitors API的要求严格对齐

修复后完整代码 #

Option Explicit

' 64位适配的API声明
#If VBA7 Then
    Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hdc As LongPtr, ByVal lprcClip As LongPtr, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Long
    Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    ' 兼容32位VBA的声明（可选保留）
    Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hdc As Long, ByVal lprcClip As Long, ByVal lpfnEnum As Long, ByVal dwData As Long) As Long
    Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If

' 显示器信息结构体（适配64位）
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type MONITORINFOEX
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
    szDevice As String * 32
End Type

' 全局变量存储显示器信息集合
Private colMonitors As Collection

' 64位适配的回调函数
#If VBA7 Then
    Private Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hdcMonitor As LongPtr, ByRef lprcMonitor As RECT, ByVal dwData As LongPtr) As Long
#Else
    Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Long
#End If
    Dim mi As MONITORINFOEX
    Dim monitorDetails As Variant
    
    ' 初始化结构体大小
    mi.cbSize = Len(mi)
    If GetMonitorInfo(hMonitor, mi) <> 0 Then
        ' 封装显示器信息（可根据需求调整字段）
        monitorDetails = Array( _
            mi.szDevice, _
            mi.rcMonitor.Left, mi.rcMonitor.Top, _
            mi.rcMonitor.Right, mi.rcMonitor.Bottom, _
            mi.rcWork.Left, mi.rcWork.Top, _
            mi.rcWork.Right, mi.rcWork.Bottom _
        )
        colMonitors.Add monitorDetails
    End If
    
    ' 返回1继续枚举所有显示器
    MonitorEnumProc = 1
End Function

' 获取所有显示器信息的主函数
Public Function GetAllMonitors() As Collection
    Dim hdc As LongPtr
    
    Set colMonitors = New Collection
    hdc = GetDC(0) ' 获取整个屏幕的设备上下文
    EnumDisplayMonitors hdc, 0, AddressOf MonitorEnumProc, 0
    ReleaseDC 0, hdc
    
    Set GetAllMonitors = colMonitors
End Function

' 示例：输出所有显示器信息
Sub TestMonitorDetection()
    Dim monitors As Collection
    Dim monitor As Variant
    Dim i As Integer
    
    Set monitors = GetAllMonitors
    
    If monitors.Count = 0 Then
        MsgBox "未检测到显示器"
        Exit Sub
    End If
    
    For i = 1 To monitors.Count
        monitor = monitors(i)
        Debug.Print "显示器" & i & ":"
        Debug.Print "  设备名: " & Trim(monitor(0))
        Debug.Print "  全屏区域: Left=" & monitor(1) & ", Top=" & monitor(2) & ", Right=" & monitor(3) & ", Bottom=" & monitor(4)
        Debug.Print "  工作区域: Left=" & monitor(5) & ", Top=" & monitor(6) & ", Right=" & monitor(7) & ", Bottom=" & monitor(8)
        Debug.Print
    Next i
End Sub

使用说明 #

1. 将代码复制到VBA模块中
2. 运行TestMonitorDetection宏，可在立即窗口查看所有显示器的设备名、全屏区域和工作区域信息
3. 若需自定义处理显示器数据，可修改MonitorEnumProc中的信息封装逻辑

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