Detect and set dual monitor resolution

I would like to detect and set dual monitor resolution in ms access vba.
Thanks
SvgmassiveAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

DatabaseMX (Joe Anderson - Microsoft Access MVP)Database ArchitectCommented:
These two free tools may help you - I've used them several times.

Get Screen Resolution
http://www.peterssoftware.com/c_scrres.htm

Window Manipulation Examples
http://www.peterssoftware.com/winmanip.htm
0
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database ArchitectCommented:
OK ... I found this code I use for this purpose.  
I have this in a Standard Module.

Option Compare Database
Option Explicit


   'Functions for determining dual(or more)monitors, as well as screen size (resolution)

    Private Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
    Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
    Private Declare 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 Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Boolean
   
    Private Const CCHDEVICENAME = 32
    Private Const MONITORINFOF_PRIMARY = &H1
   
    Private 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
   
    Public MonitorID() As String

Public Sub MI_zTest()

    Dim MONITORINFOEX As MONITORINFOEX
    MONITORINFOEX.cbSize = Len(MONITORINFOEX)

    'Dim i As Integer
    'Debug.Print "Number of monitors in this system : " &
    MI_GetMonitorCnt
    Call GetMonitorInfo(CLng(MonitorID(2)), MONITORINFOEX)
   
    'Debug.Print MonitorID(1)
    'MI_zPrintMonitorInfo (MonitorID(1))
    With MONITORINFOEX
        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
     
'    For i = 1 To UBound(MonitorID)
'        MI_zPrintMonitorInfo (MonitorID(i))
'    Next i
End Sub

Public Function MI_GetMonitorCnt()

    'Note: dual screen systems are not available on all Win versions.
    ReDim MonitorID(0)
   
    If MI_FunctionExist("user32.dll", "EnumDisplayMonitors") = True Then
        If EnumDisplayMonitors(&H0, ByVal &H0, AddressOf MI_MonitorEnumProc, &H0) = False Then
            MI_zError "EnumDisplayMonitors"
        End If
    End If
    MI_GetMonitorCnt = UBound(MonitorID)
   
End Function


Private Sub MI_zPrintMonitorInfo(ForMonitorID As String)
   
    Dim MONITORINFOEX As MONITORINFOEX
    MONITORINFOEX.cbSize = Len(MONITORINFOEX)
   
    If GetMonitorInfo(CLng(ForMonitorID), MONITORINFOEX) = False Then MI_zError "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 MI_FunctionExist(ByVal strModule As String, ByVal strFunction As String) As Boolean
   
    Dim hHandle As Long
    hHandle = GetModuleHandle(strModule)
    If hHandle = &H0 Then
        MI_zError "GetModuleHandle"
        hHandle = LoadLibraryEx(strModule, &H0, &H0): If hHandle = &H0 Then MI_zError "LoadLibrary"
        If GetProcAddress(hHandle, strFunction) = &H0 Then
            MI_zError "GetProcAddress"
        Else
            MI_FunctionExist = True
        End If
        If FreeLibrary(hHandle) = False Then MI_zError "FreeLibrary"
    Else
        If GetProcAddress(hHandle, strFunction) = &H0 Then
            MI_zError "GetProcAddress"
        Else
            MI_FunctionExist = True
        End If
    End If
   
End Function


Public Sub MI_zError(ByVal strFunction As String)

    If Err.LastDllError = 0 Then
        MsgBox strFunction & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "MI_zError", "Error"
    Else
        MsgBox Err.LastDllError, strFunction
    End If

End Sub


Public Function MI_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)
    MI_MonitorEnumProc = 1
   
End Function
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.