返回 2. 修改回调函数
3.
4. 使用
VBA 64位 Type-Mismatch 错误修复：多显示器检测
windows
2025-03-11 22:18:23
VBA 代码 "Type-Mismatch" 错误修复：多显示器检测
在使用 VBA 检测多显示器时，经常会遇到 AddressOf MonitorEnumProc 部分导致的 "Type-mismatch" 编译错误。这个问题通常出现在 64 位 VBA 环境 (VBA 7.1) 中。下面我们就来详细分析一下问题的原因，并提供解决方案。
一、 问题原因
核心问题在于 64 位 VBA 对指针类型的处理与 32 位不同。 AddressOf 运算符返回的是一个函数指针，在 32 位系统中，这个指针是一个 Long 类型。但在 64 位系统中，指针需要一个 LongPtr 类型来存储。原始代码没有考虑到这种差异，导致类型不匹配。
另外，API 函数声明在64位系统中也有不同,需要做相应的修改。
二、 解决方案
解决这个问题，我们需要修改代码以兼容 64 位 VBA，并正确处理函数指针。
1. 修改 API 函数声明
首先, 对于使用了Declare声明的 Windows API, 尤其是牵扯到指针或者句柄之类的参数或者返回值的函数, 要在Declare后增加PtrSafe. 对于函数参数以及返回值:
- 在 32 位系统中,
Long可以保存指针或句柄。 - 在 64 位系统中，需要使用
LongPtr来保存指针或句柄。LongPtr在 32 位系统中等同于Long，在 64 位系统中等同于LongLong。
据此修改代码:
Option Explicit
' 使用 PtrSafe 关键字，并使用 LongPtr 类型
Public Declare PtrSafe Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As LongPtr, ByVal dwFlags As Long) As LongPtr
Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As LongPtr) As Boolean
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Boolean
Public Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean
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
原理说明： PtrSafe 关键字告诉编译器该 API 声明已更新为可在 64 位环境中安全使用。LongPtr 是一个条件编译类型，它会根据 VBA 环境（32 位或 64 位）自动解析为 Long 或 LongLong，确保指针或句柄能被正确存储。
2. 修改回调函数 MonitorEnumProc 的声明
回调函数 MonitorEnumProc 的参数和返回值也可能需要适应 64 位环境。 它的参数hMonitor和hdcMonitor为句柄, 需要使用LongPtr:
Public Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hdcMonitor As LongPtr, ByRef lprcMonitor As RECT, ByVal dwData As LongPtr) As Boolean
' ... 其他代码保持不变 ...
End Function
原理 : 和 API 的修改相似, 回调函数也要正确处理句柄参数.
3. GetMonitorInfo函数中的CLng 替换为 CLngPtr
为了保证在64位系统上, 将String类型的hMonitor转换为正确的指针类型， 需要把 CLng 替换为 CLngPtr:
Private Sub PrintMonitorInfo(ForMonitorID As String)
Dim MONITORINFOEX As MONITORINFOEX
MONITORINFOEX.cbSize = LenB(MONITORINFOEX) '更安全的写法,应对Unicode字符
If GetMonitorInfo(CLngPtr(ForMonitorID), MONITORINFOEX) = False Then Failed "GetMonitorInfo"
' ... 其他代码保持不变 ...
End Sub
原理 : CLngPtr 是条件编译类型, 会正确地将字符串转化为 Long 或 LongLong.
4. 使用 LenB 替代 Len
在获取 MONITORINFOEX 结构体大小, 使用LenB函数代替Len:
MONITORINFOEX.cbSize = LenB(MONITORINFOEX)
原理 ：LenB 返回用于存储变量的字节数,而Len返回字符串的字符数.对于MONITORINFOEX这种结构,用LenB会得到更准确的结果. 特别是在Unicode环境中。
5. 完整代码
整合以上修改，完整的、可在 64 位 VBA 中运行的代码如下：
Option Explicit
Public Declare PtrSafe Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As LongPtr, ByVal dwFlags As Long) As LongPtr
Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As LongPtr) As Boolean
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Boolean
Public Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean
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
Public Sub TestDisplayInfo()
Dim i As Integer
Debug.Print "Number of monitors in this system : " & GetMonitorId
Debug.Print
For i = 1 To UBound(MonitorId)
PrintMonitorInfo (MonitorId(i))
Next i
End Sub
Public Function GetMonitorId()
ReDim MonitorId(0)
If FunctionExist("user32.dll", "EnumDisplayMonitors") = True Then
If EnumDisplayMonitors(&H0, ByVal &H0, AddressOf MonitorEnumProc, &H0) = False Then
Failed "EnumDisplayMonitors"
End If
End If
GetMonitorId = UBound(MonitorId)
End Function
Private Sub PrintMonitorInfo(ForMonitorID As String)
Dim MONITORINFOEX As MONITORINFOEX
MONITORINFOEX.cbSize = LenB(MONITORINFOEX)
If GetMonitorInfo(CLngPtr(ForMonitorID), MONITORINFOEX) = False Then Failed "GetMonitorInfo"
With MONITORINFOEX
Debug.Print "Monitor info for device number : " & ForMonitorID
Debug.Print "---------------------------------------------------"
Debug.Print "Device Name : " & .szDevice
If .dwFlags And MONITORINFOF_PRIMARY Then Debug.Print "Primary Display = True" Else Debug.Print "Primary Display = False"
With .rcMonitor
Debug.Print "Monitor Left : " & .Left
Debug.Print "Monitor Top : " & .Top
Debug.Print "Monitor Right : " & .Right
Debug.Print "Monitor Bottom : " & .Bottom
End With
With .rcWork
Debug.Print "Work area Left : " & .Left
Debug.Print "Work area Top : " & .Top
Debug.Print "Work area Right : " & .Right
Debug.Print "Work area Bottom : " & .Bottom
End With
End With
Debug.Print
Debug.Print
End Sub
Public Function FunctionExist(ByVal strModule As String, ByVal strFunction As String) As Boolean
Dim hHandle As LongPtr
hHandle = GetModuleHandle(strModule)
If hHandle = &H0 Then
Failed "GetModuleHandle"
hHandle = LoadLibraryEx(strModule, &H0, &H0): If hHandle = &H0 Then Failed "LoadLibrary"
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
If FreeLibrary(hHandle) = False Then Failed "FreeLibrary"
Else
If GetProcAddress(hHandle, strFunction) = &H0 Then
Failed "GetProcAddress"
Else
FunctionExist = True
End If
End If
End Function
Public Sub Failed(ByVal strFunction As String)
Debug.Print strFunction & "Failed"
End Sub
Public Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hdcMonitor As LongPtr, ByRef lprcMonitor As RECT, ByVal dwData As LongPtr) 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
6. 安全建议 (条件编译)
如果你的VBA代码需要同时兼容32位和64位环境，可以使用条件编译。示例:
#If VBA7 Then
' 64-bit declarations (使用 LongPtr, PtrSafe)
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Boolean
#Else
' 32-bit declarations (使用 Long)
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
#End If
#If VBA7 Then
Public Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hdcMonitor As LongPtr, ByRef lprcMonitor As RECT, ByVal dwData As LongPtr) As Boolean
#Else
Public Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
#End If
原理 ：#If VBA7 会检查当前 VBA 版本是否为 7 或更高版本（即 64 位环境）。如果是，则使用 #If VBA7 和 #Else 之间的代码；否则, 使用 #Else 和 #End If 之间的代码。 这使你的代码能根据运行环境选择正确的声明。 其他涉及到 LongPtr的地方也应该用条件编译进行相似的处理.
