VBA调用Win32 API GetDeviceCaps时VERTRES变量未定义如何解决

错误根因 #

• 代码开头启用了Option Explicit强制声明规则，VERTRES属于Win32 API的预定义常量，VBA原生环境没有内置该常量的定义，未手动声明直接调用就会触发「变量未定义」编译错误
• 原有API声明缺少位兼容适配，在64位Office环境下会触发类型不匹配、运行时崩溃等问题

修复后完整代码 #

Option Explicit

' 补充API常量定义，VERTRES对应值为10，用于获取设备垂直像素分辨率
Private Const VERTRES As Long = 10
' 若需要获取水平分辨率可新增以下常量
' Private Const HORZRES As Long = 8

Private Type POINTAPI
    x As Long
    y As Long
End Type

' 声明添加PtrSafe适配32/64位Office，统一参数类型
Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hDC As LongPtr, _
    ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" _
        (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetWindowDC Lib "user32" (ByVal hwnd As LongPtr) _
        As LongPtr
        
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" ( _
       ByVal hDC As LongPtr _
       , ByVal nIndex As Long _
       ) As Long
        

Public Sub Test()
    Dim tPOS As POINTAPI
    Dim AColor As Long
    Dim ADC As LongPtr
    ' 注意：VERTRES取的是垂直分辨率，对应高度，原命名width容易混淆，可按需修改为height
    Dim deviceHeight As Integer
    

    ADC = GetWindowDC(0)
    deviceHeight = GetDeviceCaps(ADC, VERTRES)
            
    Call GetCursorPos(tPOS)
    AColor = GetPixel(ADC, tPOS.x, tPOS.y)
    

    ActiveWindow.Selection.ShapeRange(1).Fill.ForeColor.RGB = 14588691
    Debug.Print "device height:"
    Debug.Print deviceHeight

End Sub

关键修改说明 #

• 新增了VERTRES常量的手动定义，对应值为10，符合Win32 API的参数约定
• 为所有API声明添加PtrSafe关键字，调整句柄相关参数类型为LongPtr，兼容32位、64位Office运行环境
• 调整了ADC变量的类型为LongPtr，和API参数要求匹配，避免类型不匹配错误
• 修正了变量命名歧义，VERTRES返回的是屏幕垂直方向像素数，原命名width容易造成误解

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