Dual Monitor Setting in VBA

[Tiger Chen]

When I connect my laptop to a second monitor or projector, I set up two monitors manually to display independently. (i can set them display the same; or use anyone of them only manually too.)

However, is there a way to set it up in VBA code, or use any API?

There are some codes to determine how many monitors and what are their dimensions. However, nobody mention how to set up the display.

Thanks in advance!

[Tiger Chen]

http://officeone.mvps.org/display_assist/display_assist.html
here is a software, but i would like to know how to make it in VBA/VB/VS.

[Bob Phillips]

I use Ultramon, and here is a page about using the Ultramon API. Can't say I have ever done it though.

[Tiger Chen]

I got samples in C++ and VB.net that can set extended desktop successfully. The API ChangeDisplaySettingsEx is the key.

However, I cannot make it in VBA. i dont know what's wrong with it, even the API return successful result (0).

here is my codes:
Option Explicit
'Constants
Public Const DD_Desktop = &H1
Public Const DD_MultiDriver = &H2
Public Const DD_Primary = &H4
Public Const DD_Mirror = &H8
Public Const DD_VGA = &H10
Public Const DD_Removable = &H20
Public Const DD_ModeSpruned = &H8000000
Public Const DD_Remote = &H4000000
Public Const DD_Disconnect = &H2000000

Public Const DD_Active = &H1
Public Const DD_Attached = &H2

Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

Public Const ENUM_CURRENT_SETTINGS = -1
Public Const ENUM_REGISTRY_SETTINGS = -2

Public Const MONITOR_DEFAULTTONULL = 0
Public Const MONITOR_DEFAULTTOPRIMARY = 1
Public Const MONITOR_DEFAULTTONEAREST = 2

'User Defined Types
Private Type DisplayDevice
cb As Long
DeviceName As String * 32
DeviceString As String * 128
StateFlags As Long
DeviceID As String * 128
DeviceKey As String * 128
End Type

Private Type POINTL
x As Long
y As Long
End Type

Private Type DEVMODE
DeviceName As String * CCHDEVICENAME
SpecVersion As Integer
DriverVersion As Integer
Size As Integer
DriverExtra As Integer
Fields As Long
Position As POINTL
Scale As Integer
Copies As Integer
DefaultSource As Integer
PrintQuality As Integer
Color As Integer
Duplex As Integer
YResolution As Integer
TTOption As Integer
Collate As Integer
FormName As String * CCHFORMNAME
LogPixels As Integer
BitsPerPel As Long
PelsWidth As Long
PelsHeight As Long
DisplayFlags As Long
DisplayFrequency As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type MonitorInfo
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
End Type

'Declares
Public Declare Function EnumDisplayDevices Lib "user32" Alias "EnumDisplayDevicesA" (ByVal lpDevice As String, _
ByVal iDevNum As Long, lpDisplayDevice As DisplayDevice, dwFlags As Long) As Long
Public Declare Function EnumDisplaySettingsEx Lib "user32" Alias "EnumDisplaySettingsExA" (ByVal lpszDeviceName As String, _
ByVal iModeNum As Long, lpDevMode As DEVMODE, dwFlags As Long) As Long
Public Declare Function MonitorFromPoint Lib "user32" (ByVal ptY As Long, ByVal ptX As Long, ByVal dwFlags As Long) As Long
Public Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, lpmi As MonitorInfo) As Long
Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" (lpszDeviceName As Any, _
lpDevMode As Any, ByVal hWnd As Long, ByVal dwFlags As Long, lParam As Any) As Long


'Public Parts that will be used
Public Type Monitors
Name As String
Handle As Long
x As Long
y As Long
Width As Long
Height As Long
DevString As String
Detected As Boolean
End Type
Public PrimaryMon As Monitors
Public SecondaryMon As Monitors
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'Declare Function GetSystemMetrics16 Lib "user" _
'Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

'------------------------------------------------------------------------
Public vidwidth As Integer
Public vidheight As Integer
Dim Msg
Dim ans
Dim msg1
Public Originalvidwidth As Integer 'stores original screen setting to use to restore later
Public Originalvidheight As Integer 'stores original screen setting to use to restore later
Public ResetScreen As Boolean


Public Sub GetDisplays()
Dim DispDev As DisplayDevice, MonDev As DisplayDevice 'holds device info/monitor info
Dim DispDevInd As Long, MonDevInd As Long 'Index for the devices
Dim MonMode As DEVMODE 'holds mode information for each monitor
Dim hMonitor As Long 'holds handle to the correct monitor context
Dim MonInfo As MonitorInfo

'initialisations
DispDev.cb = Len(DispDev)
MonDev.cb = Len(MonDev)
DispDevInd = 0: MonDevInd = 0
PrimaryMon.Detected = False
SecondaryMon.Detected = False

Do While EnumDisplayDevices(vbNullString, DispDevInd, DispDev, 0) <> 0 'enumerate the graphics cards
If Not CBool(DispDev.StateFlags And DD_Mirror) Then
'if it is real
Do While EnumDisplayDevices(DispDev.DeviceName, MonDevInd, MonDev, 0) <> 0 'iterate to the correct MonDev
If CBool(MonDev.StateFlags And DD_Active) Then Exit Do
MonDevInd = MonDevInd + 1
Loop
'if the device string is empty then its a default monitor
If cCstr(MonDev.DeviceString) = "" Then
EnumDisplayDevices DispDev.DeviceName, 0, MonDev, 0
If cCstr(MonDev.DeviceString) = "" Then MonDev.DeviceString = "Default Monitor"
End If
'get information about the display's position and the current display mode

MonMode.Size = Len(MonMode)
If EnumDisplaySettingsEx(DispDev.DeviceName, ENUM_CURRENT_SETTINGS, MonMode, 0) = 0 Then
EnumDisplaySettingsEx DispDev.DeviceName, ENUM_REGISTRY_SETTINGS, MonMode, 0
End If

'get the monitor handle and workspace

MonInfo.cbSize = Len(MonInfo)
If CBool(DispDev.StateFlags And DD_Desktop) Then
'display is enabled. only enabled displays have a monitor handle
hMonitor = MonitorFromPoint(MonMode.Position.x, MonMode.Position.y, MONITOR_DEFAULTTONULL)
If hMonitor <> 0 Then
GetMonitorInfo hMonitor, MonInfo
End If
End If
End If
If CBool(DispDev.StateFlags And DD_Desktop) Then 'if it is an active monitor
If CBool(DispDev.StateFlags And DD_Primary) Then 'if itis the primary
With PrimaryMon
If MonDev.DeviceName <> "" Then .Name = cCstr(MonDev.DeviceName) Else .Name = cCstr(DispDev.DeviceName)
MsgBox "1: " & .Name
.Detected = True
.Handle = hMonitor
.DevString = cCstr(MonDev.DeviceString) & " on " & cCstr(DispDev.DeviceString)
MsgBox .DevString
.x = MonMode.Position.x
.y = MonMode.Position.y
.Width = MonMode.PelsWidth
.Height = MonMode.PelsHeight
End With
Else
If Not SecondaryMon.Detected Then 'if it is a secondary (only do one)
With SecondaryMon
If MonDev.DeviceName <> "" Then .Name = cCstr(MonDev.DeviceName) Else .Name = cCstr(DispDev.DeviceName)
MsgBox "2: " & .Name
.Detected = True
.Handle = hMonitor
.DevString = cCstr(MonDev.DeviceString) & " on " & cCstr(DispDev.DeviceString)
MsgBox .DevString
.x = MonMode.Position.x
.y = MonMode.Position.y
.Width = MonMode.PelsWidth
.Height = MonMode.PelsHeight
End With
End If
End If
End If
DispDevInd = DispDevInd + 1 'next graphics card
Loop

End Sub

Private Function cCstr(str As String) As String
Dim i As Long
Dim char As String
Dim Returned As String

For i = 1 To Len(str)
char = Mid(str, i, 1)
If char <> vbNullChar And char <> vbNullString Then
Returned = Returned & char
End If
Next

cCstr = Returned

End Function
Public Sub DetectDualMonitor()
GetDisplays
vidwidth = GetSystemMetrics(SM_CXSCREEN)
vidheight = GetSystemMetrics(SM_CYSCREEN)
If SecondaryMon.Detected = True Then
If vidwidth = 1024 And vidheight = 768 Then
Exit Sub
Else
ans = MsgBox("A secondary monitor connection has been detected." & vbCrLf & _
"If this is for a presentation projector, would you like this program" & vbCrLf & _
"to change your screen resolution to 1024 x 768 so that the" & vbCrLf & _
"Issue Sheet and TTM plans will fill a standard projection screen?", vbYesNo)
End If
End If

If ans = vbYes Then
'Replace '1024,768,32,75' with the resolution you want to switch to.
'You can change the color pallete by changing the '32' below with '16' ect...
'You can also change refresh rate
Originalvidwidth = vidwidth
Originalvidheight = vidheight
ResetScreen = True
' ChangeScreenSettings 1024, 768, 32, 60
' DoCmd.Close acForm, "frmMainEntryMenu", acSaveNo
' DoCmd.OpenForm "frmMainEntryMenu"
' Forms!frmMainEntryMenu!LblRestore.Visible = True
' Forms!frmMainEntryMenu!btnRestoreScreen.Visible = True
' Forms!frmMainEntryMenu!btnSet1024x768.Visible = False
' Forms!frmMainEntryMenu!LblPresentation.Visible = False
Else
' Forms!frmMainEntryMenu!LblRestore.Visible = False
' Forms!frmMainEntryMenu!btnRestoreScreen.Visible = False
' Forms!frmMainEntryMenu!btnSet1024x768.Visible = True
' Forms!frmMainEntryMenu!LblPresentation.Visible = True
Exit Sub
End If

End Sub
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Private Const DISP_CHANGE_SUCESSFUL As Long = 0
'Private Const DISP_CHANGE_RESTART As Long = 1
'Private Const DISP_CHANGE_FAILED As Long = -1
'Private Const DISP_CHANGE_BADMODE As Long = -2
'Private Const DISP_CHANGE_NOTUPDATED As Long = -3
'Private Const DISP_CHANGE_BADFLAGS As Long = -4
'Private Const DISP_CHANGE_BADPARAM As Long = -5
Public Sub SetExtDeskTop()
Dim dmPrimary As DEVMODE
Dim dmSecondary As DEVMODE
Dim dmTemp As DEVMODE
' const DMBITSPERPEL AS Long =0x00040000

Const szPrimaryDisplay As String = "\\.\DISPLAY1 (file://\\.\DISPLAY1)"
Const szSecondaryDisplay As String = "\\.\DISPLAY2 (file://\\.\DISPLAY2)"
Const CDS_UPDATEREGISTRY As Long = &H1
Const CDS_NORESET As Long = &H10000000
Const CDS_RESET As Long = &H40000000
Const DM_BITSPERPEL As Long = &H40000
Const DM_PELSWIDTH As Long = &H80000
Const DM_PELSHEIGHT As Long = &H100000
Const DM_POSITION As Long = &H20
Const DM_DISPLAYFREQUENCY As Long = &H400000

Dim lngExtSucc As Long

dmPrimary.Size = Len(dmPrimary)
dmTemp.Size = Len(dmTemp)
dmSecondary.Size = Len(dmSecondary)

If EnumDisplaySettings(szPrimaryDisplay, ENUM_CURRENT_SETTINGS, dmTemp) = False Then
MsgBox "Primary Settings couldn't be enumerated."
Else
' With dmTemp
' Debug.Print "BitsPerPel: " & .BitsPerPel
' Debug.Print "Collate: " & .Collate
' Debug.Print "Color: " & .Color
' Debug.Print "Copies: " & .Copies
' Debug.Print "DefaultSource: " & .DefaultSource
' Debug.Print "DeviceName: " & .DeviceName
' Debug.Print "DisplayFlags: " & .DisplayFlags
' Debug.Print "DisplayFrequency: " & .DisplayFrequency
' Debug.Print "DriverExtra: " & .DriverExtra
' Debug.Print "DriverVersion: " & .DriverVersion
' Debug.Print "Duplex: " & .Duplex
' Debug.Print "Fields: " & .Fields
' Debug.Print "FormName: " & .FormName
' Debug.Print "LogPixels: " & .LogPixels
' Debug.Print "PelsHeight: " & .PelsHeight
' Debug.Print "PelsWidth: " & .PelsWidth
' Debug.Print "Position.x: " & .Position.x
' Debug.Print "Position.y: " & .Position.y
' Debug.Print "PrintQuality: " & .PrintQuality
' Debug.Print "Scale: " & .Scale
' Debug.Print "Size: " & .Size
' Debug.Print "SpecVersion: " & .SpecVersion
' Debug.Print "TTOption: " & .TTOption
' Debug.Print "YResolution: " & .YResolution
' End With
With dmPrimary
.BitsPerPel = dmTemp.BitsPerPel
.PelsHeight = dmTemp.PelsHeight
.PelsWidth = dmTemp.PelsWidth
.DisplayFrequency = dmTemp.DisplayFrequency
.Fields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
With .Position
.x = dmTemp.Position.x
.y = dmTemp.Position.y
End With
.Fields = .Fields Or DM_POSITION
End With
If dmPrimary.DisplayFrequency <> 0 Then _
dmPrimary.Fields = dmPrimary.Fields Or DM_DISPLAYFREQUENCY
With dmSecondary
.BitsPerPel = dmPrimary.BitsPerPel
.PelsHeight = dmPrimary.PelsHeight
.PelsWidth = dmPrimary.PelsWidth
.DisplayFrequency = 60
.Fields = (DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT)
If .DisplayFrequency <> 0 Then _
.Fields = .Fields Or DM_DISPLAYFREQUENCY

With .Position
.x = dmPrimary.PelsWidth + 1
.y = 0
End With
.Fields = .Fields Or DM_POSITION
End With

' lngExtSucc = ChangeDisplaySettingsEx(szPrimaryDisplay, _
' dmPrimary, 0&, UPDATEREGISTRY Or NORESET, 0&)
'
' MsgBox lngExtSucc

If ChangeDisplaySettingsEx(szPrimaryDisplay, _
dmPrimary, 0&, CDS_UPDATEREGISTRY Or CDS_NORESET, 0&) = 0 Then
If ChangeDisplaySettingsEx(szSecondaryDisplay, _
dmSecondary, 0&, CDS_UPDATEREGISTRY Or CDS_NORESET, 0&) = 0 Then
If ChangeDisplaySettingsEx(vbNullString, _
vbNull, 0&, 0&, 0&) = 0 Then
lngExtSucc = ChangeDisplaySettingsEx(szPrimaryDisplay, dmPrimary, _
vbNull, CDS_UPDATEREGISTRY Or CDS_RESET, 0&)
MsgBox "Extended Desktop Set Successfully"
Else
MsgBox "Final CDS call failed"
End If
Else
MsgBox "Second CDS call failed"
End If
Else
MsgBox "First CDS call failed"
End If
End If
End Sub

[Tiger Chen]

Can anybody help here? i believe there is a solution!