windows - How to fix 'Type-Mismatch' error generated by vba code - Stack Overflow

admin管理员组

文章数量:1315069

I have been looking for some vba code to detect multiple monitors and came across the following at .664070/

It looked promising but when I compile it under vba 7.1 (64-bit) I get the following error:

Compile error: Type-mismatch for the part AddressOf MonitorEnumProc.

Does anyone know how to fix this error ? I have tried searching for this specific string in Google with no success. While performing the search I have found multiple sites that use very similar code but they ALL fail with the same Type-mismatch error!

Option Explicit

Public Declare PtrSafe Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Public Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, 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 = Len(MONITORINFOEX)
    If GetMonitorInfo(CLng(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 Long
    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 Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) 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

I have been looking for some vba code to detect multiple monitors and came across the following at https://www.mrexcel/board/threads/userforms-and-muiltiple-mointors.664070/

It looked promising but when I compile it under vba 7.1 (64-bit) I get the following error:

Compile error: Type-mismatch for the part AddressOf MonitorEnumProc.

Does anyone know how to fix this error ? I have tried searching for this specific string in Google with no success. While performing the search I have found multiple sites that use very similar code but they ALL fail with the same Type-mismatch error!

Option Explicit

Public Declare PtrSafe Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare PtrSafe Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Public Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Public Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, 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 = Len(MONITORINFOEX)
    If GetMonitorInfo(CLng(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 Long
    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 Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) 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

• vba
• windows

Share Improve this question Follow asked Jan 30 at 10:33 Chazg76Chazg76 64966 silver badges1414 bronze badges 2

• 2 I think I have found it! I changed the value from Long to LongPtr for the variable lpfnEnum in the declaration of function EnumDisplayMonitors. Now the code compiles without any errors! – Chazg76 Commented Jan 30 at 10:49
• You could write this solution as an answer and then accept it. – June7 Commented Jan 30 at 19:37

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 0

As mentioned in my comment, I changed the value from Long to LongPtr for the variable lpfnEnum in the declaration of function EnumDisplayMonitors. Now the code compiles without any errors!

本文标签： windowsHow to fix 39TypeMismatch39 error generated by vba codeStack Overflow