I have a VacationCalendar PC that has 2 monitors. I also have 2 excel spreadsheets, a LEFT and a RIGHT. I am wanting to open up the RIGHT spreadsheet and move it over to the RIGHT screen when the script is ran.
Excel does remember it's last windows position, but it does not do it for individual spreadsheets from my testing, it will always open the spreadsheet on the last monitor that the software was open in.
Here is my current batch script:
@echo off
start excel.exe "C:\Users\vacationcalendar\Desktop\VacationCalendar_RIGHT.xlsx"
timeout /t 5 /nobreak >nul
powershell -Command "(new-object -ComObject WScript.Shell).SendKeys('{ESC}')"
timeout /t 1 /nobreak >nul
powershell -Command "(new-object -ComObject WScript.Shell).SendKeys('{#}{SHIFT}{RIGHT}')"
timeout /t 15 /nobreak >nul
start excel.exe "C:\Users\vacationcalendar\Desktop\VacationCalendar_LEFT.xlsx"
It opens the right file, then waits 5 seconds and then sends a keypress of ESC. It does this because when the excel file opens, a cell is highlighted. But I don't believe it is working, because when it sends the {#}{SHIFT}{RIGHT} keystroke, it puts the '#' symbol into the highlighted cell.
The {#}{SHIFT}{RIGHT} keystroke is supposed to represent WINKEY + SHIFT + RIGHT ARROW to move the window the the right monitor.
What could I do better/learn to get this to work?
VBA Macro I tried:
Sub OpenAndPositionWorkbooks()
Dim ExcelApp As Object
Dim Workbook1 As Object
Dim Workbook2 As Object
' Create a new instance of Excel
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
' Open the first workbook and position it on the left monitor
Set Workbook1 = ExcelApp.Workbooks.Open("C:\Users\whull\Desktop\VacationCalendar_LEFT.xlsx")
Workbook1.Windows(1).WindowState = xlMaximized
Workbook1.Windows(1).Left = 0
' Open the second workbook and position it on the right monitor
Set Workbook2 = ExcelApp.Workbooks.Open("C:\Users\whull\Desktop\VacationCalendar_RIGHT.xlsx")
Workbook2.Windows(1).WindowState = xlMaximized
Workbook2.Windows(1).Left = Screen.Width \ Screen.TwipsPerPixelX
' Release objects
Set Workbook1 = Nothing
Set Workbook2 = Nothing
Set ExcelApp = Nothing
End Sub
Try this code. This will move the Excel file to the Right Monitor. I have tried it and it works. I have commented the code so you should not have a problem understanding it.
Important Note: Since we are using VBA code, your files need to be saved as .xlsm
and not .xlsx
In the ThisWorkbook Code module.
Option Explicit
Private Declare PtrSafe Function SetWindowPos Lib "user32" (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 wFlags As Long) As Long
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_NOZORDER As Long = &H4
Private Sub Workbook_Open()
Dim leftPos As Long
Dim appHwnd As Long
'~~> Get the left position of the second monitor
leftPos = GetSecondMonitorLeft()
If leftPos = -1 Then
MsgBox "No second monitor detected.", vbInformation
Else
'~~> Get the handle of the Excel application window
appHwnd = Application.hwnd
'~~> This is important because you can't move a maximized window
Application.WindowState = xlNormal
'~~> Move the application window to the second monitor
SetWindowPos appHwnd, 0, leftPos, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
'~~> Maximize the application window
Application.WindowState = xlMaximized
End If
End Sub
In a normal Module
Option Explicit
Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias _
"GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hdc As LongPtr, _
ByVal lprcClip As LongPtr, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Boolean
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias _
"GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As Any) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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
Private Const SM_CMONITORS As Long = 80
'~~> This function gets the .Left of the 2nd monitor
Public Function GetSecondMonitorLeft() As Long
Dim monitorCount As Integer
Dim monitorInfo As monitorInfo
Dim hdc As LongPtr
Dim monCount As Long
monitorInfo.cbSize = Len(monitorInfo)
hdc = 0
'~~> This will get the number of monitors
monitorCount = GetSystemMetrics32(SM_CMONITORS)
'~~> Check if there are at least 2 monitors
If monitorCount >= 2 Then
'~~> Get the information of the second monitor
EnumDisplayMonitors 0, ByVal 0, AddressOf MonitorEnumProc, VarPtr(monitorInfo)
monCount = monitorInfo.rcMonitor.Left
Else
'~~> If there is only 1 monitor, return -1
monCount = -1
End If
GetSecondMonitorLeft = monCount
End Function
Private Function MonitorEnumProc(ByVal hMonitor As LongPtr, ByVal hdcMonitor As LongPtr, _
ByVal lprcMonitor As LongPtr, ByVal dwData As LongPtr) As Long
Dim monitorInfo As monitorInfo
monitorInfo.cbSize = Len(monitorInfo)
GetMonitorInfo hMonitor, monitorInfo
'~~> Here we copy the monitor info to the provided structure
CopyMemory ByVal dwData, monitorInfo, Len(monitorInfo)
'~~> Next enumeration
MonitorEnumProc = 1
End Function
Sample File:
You can download a sample file from Here to test it.
Followup:
To open the Excel file in the left window, use this code. I tested it and it works.
Private Sub Workbook_Open()
Dim leftPos As Long
Dim appHwnd As Long
'~~> Get the left position of the second monitor
leftPos = -1
'~~> Get the handle of the Excel application window
appHwnd = Application.Hwnd
'~~> This is important because you can't move a maximized window
Application.WindowState = xlNormal
'~~> Move the application window to the second monitor
SetWindowPos appHwnd, 0, leftPos, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
'~~> Maximize the application window
Application.WindowState = xlMaximized
End Sub