Is there a way to auto open an excel file and move it to the right monitor?

96 Views Asked by At

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
1

There are 1 best solutions below

13
Siddharth Rout On BEST ANSWER

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