Currently I have two monitors (side by side) and in Excel the workbooks are opened on a specific monitor. I wish to move the visible workbooks to the opposite monitor. So if the workbook is on monitor 1, I wish to move it to monitor 2 and vice versa. I have code which can do everything I need except getting the correct monitor a workbook is on. So for example if I have four workbooks open, they could be on two different monitors. Then I would like to switch them. I do hope this is possible! I can move a workbook from the right monitor to the left monitor but it does not determine the correct monitor and that is my issue. See the below code in VBA for Excel. Does anyone have a solution which works?
There might be some redundant code in between because I have been trying a lot of things in different ways.
Option Explicit
Private Const ENUM_CURRENT_SETTINGS As Long = -1
Private Const DISPLAY_DEVICE_ATTACHED_TO_DESKTOP As Long = &H1
Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32
Private Type DISPLAY_DEVICE
cb As Long
DeviceName As String * CCHDEVICENAME
DeviceString As String * 128
StateFlags As Long
DeviceID As String * 128
DeviceKey As String * 128
End Type
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare PtrSafe Function EnumDisplayDevices Lib "user32.dll" Alias "EnumDisplayDevicesA" (ByVal lpDevice As String, ByVal iDevNum As Long, ByRef lpDisplayDevice As DISPLAY_DEVICE, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
Private Declare PtrSafe Function MoveWindow Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SW_MAXIMIZE = 3
Public FirstMonitor As String
Public SecondMonitor As String
Public oppositeDisplayName As String
Public DeviceName As String
Sub MoveExcelWorkbook()
Dim hWnd As LongPtr
Dim excelApp As Object
Dim wb As Workbook
' Create Excel application object
On Error Resume Next
Set excelApp = GetObject(, "Excel.Application")
If Err.number <> 0 Then
Set excelApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
If excelApp Is Nothing Then
MsgBox "Failed to create or get Excel Application object."
Exit Sub
End If
DisplayNumberOfMonitors
' Move each workbook to the target monitor
For Each wb In excelApp.Workbooks
If wb.windows(1).Visible = True Then
Debug.Print "wb.Name: " & wb.name
wb.activate
hWnd = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
If hWnd <> 0 Then
' Move the Excel Workbook to:
If MoveWindowToOppositeDisplay(hWnd) Then
' Maximize the Excel Workbook on opposite display
If MaximizeWindow(hWnd) Then
Debug.Print "Excel Workbook moved and maximized on " & oppositeDisplayName
Else
Debug.Print "Failed to maximize Excel Workbook on " & oppositeDisplayName
End If
Else
Debug.Print "Failed to move Excel Workbook to " & oppositeDisplayName
End If
Else
Debug.Print "Excel Workbook not found."
End If
End If
Next wb
End Sub
Private Function MoveWindowToOppositeDisplay(ByVal hWnd As LongPtr) As Boolean
' Retrieve the current display device name for the window
DeviceName = Space(128)
Call GetWindowDeviceName(hWnd, DeviceName)
' Determine the name of the opposite display
If StrComp(DeviceName, FirstMonitor, vbTextCompare) = 0 Then
oppositeDisplayName = SecondMonitor
ElseIf StrComp(DeviceName, SecondMonitor, vbTextCompare) = 0 Then
oppositeDisplayName = FirstMonitor
Else
' Window is not on display1 or display7, do not move
MoveWindowToOppositeDisplay = False
Exit Function
End If
' Move the window to the opposite display
MoveWindowToOppositeDisplay = MoveWindowToDisplay(hWnd, oppositeDisplayName)
End Function
Function MoveWindowToDisplay(ByVal hWnd As LongPtr, ByVal displayDeviceName As String) As Boolean
Dim NullCharPos As Long
' Check if the window is already on the desired display
If StrComp(DeviceName, displayDeviceName, vbTextCompare) = 0 Then
MoveWindowToDisplay = MoveWindow(hWnd, 1920, 0, 1920, 1080, True) ' Adjust width and height as needed
MoveWindowToDisplay = True
Else
' Move the window to the desired display
MoveWindowToDisplay = MoveWindow(hWnd, 0, 0, 1920, 1080, True) ' Adjust width and height as needed
MoveWindowToDisplay = True
End If
End Function
Private Function IsWindowOnDisplay(ByVal hWnd As LongPtr, ByVal displayDeviceName As String) As Boolean
Dim DeviceName As String
Dim NullCharPos As Long
DeviceName = Space(128)
Call GetWindowDeviceName(hWnd, DeviceName)
NullCharPos = InStr(DeviceName, vbNullChar)
If NullCharPos > 0 Then
DeviceName = Left$(DeviceName, NullCharPos - 1)
End If
IsWindowOnDisplay = (StrComp(DeviceName, displayDeviceName, vbTextCompare) = 0)
End Function
Private Sub GetWindowDeviceName(ByVal hWnd As LongPtr, ByRef DeviceName As String)
Dim dd As DISPLAY_DEVICE
dd.cb = Len(dd)
Call EnumDisplayDevices(vbNullString, 0, dd, 0)
Call EnumDisplayDevices(dd.DeviceName, 0, dd, 0)
DeviceName = dd.DeviceName
End Sub
Private Function MaximizeWindow(ByVal hWnd As LongPtr) As Boolean
' Maximize the window
MaximizeWindow = ShowWindow(hWnd, SW_MAXIMIZE)
End Function
Sub DisplayNumberOfMonitors()
Dim MonitorsAndScreenSize As Variant
Dim MONITORINFO As New Collection
Dim indAdapter As Long
Dim ddAdapters As DISPLAY_DEVICE
ddAdapters.cb = Len(ddAdapters)
indAdapter = 0
Do Until EnumDisplayDevices(vbNullString, indAdapter, ddAdapters, 0) = 0
If (ddAdapters.StateFlags And DISPLAY_DEVICE_ATTACHED_TO_DESKTOP) = DISPLAY_DEVICE_ATTACHED_TO_DESKTOP Then
Dim NullCharPos As Long
NullCharPos = InStr(ddAdapters.DeviceName, vbNullChar)
Dim CurDeviceName As String
If NullCharPos > 0 Then
CurDeviceName = Left$(ddAdapters.DeviceName, NullCharPos - 1)
Else
CurDeviceName = ddAdapters.DeviceName
End If
Dim dmode As DEVMODE
dmode.dmSize = Len(dmode)
EnumDisplaySettings CurDeviceName, ENUM_CURRENT_SETTINGS, dmode
MonitorsAndScreenSize = CurDeviceName
MONITORINFO.Add MonitorsAndScreenSize
End If
indAdapter = indAdapter + 1
Loop
' Display monitor information
Dim monitorInfoString As String
For Each MonitorsAndScreenSize In MONITORINFO
monitorInfoString = monitorInfoString & vbCrLf & MonitorsAndScreenSize
Next MonitorsAndScreenSize
Debug.Print monitorInfoString
'MsgBox monitorInfoString
Debug.Print MONITORINFO.count
FirstMonitor = MONITORINFO.item(1)
SecondMonitor = MONITORINFO.item(2)
End Sub