New window, move to second screen (using VBA)

Formula11

Active Member
Joined
Mar 1, 2005
Messages
463
Office Version
  1. 365
Platform
  1. Windows
I was looking into a macro to open a second window of an Excel document, on a second screen with a dual monitor setup.
Using excel command New Window, or something like ActiveWindow.NewWindow in VBA.
- The current Excel workbook may be on either monitor 1 or 2. If on monitor 1, open new window on monitor 2, if on monitor 2, open new window on monitor 1.
- The primary monitor may be Left or Right monitor, if this makes a difference.

In doing some research it looks like APIs are used.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Not tested in an actual dual monitor setting as I only have one monitor.

Place this in a Standard Module and run the Test Sub
VBA Code:
Option Explicit

Private Type POINTAPI
  x As Long
  y As Long
End Type

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

Private Type WINDOWPLACEMENT
  Length As Long
  flags As Long
  showCmd As Long
  ptMinPosition As POINTAPI
  ptMaxPosition As POINTAPI
  rcNormalPosition As RECT
End Type

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

Private Type uData
    #If Win64 Then
        hOriginalWindow As LongLong
        hNewlWindow As LongLong
    #Else
        hOriginalWindow As Long
        hNewlWindow As Long
    #End If
End Type


#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, lpmi As MONITORINFO) As Long
    Private Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hDc As LongPtr, lprcClip As Any, ByVal lpfnEnum As LongPtr, dwData As uData) As Long
    Private Declare PtrSafe Function MoveWindow Lib "user32" (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 SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, lpmi As MONITORINFO) As Long
    Private Declare Function MonitorFromWindow Lib "user32" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
    Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hDc As Long, lprcClip As Any, ByVal lpfnEnum As Long, dwData As uData) As Long
    Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long
#End If


Sub Test()
    OpenNewWindowInSecondMonitor ThisWorkbook
End Sub  
  
  
Sub OpenNewWindowInSecondMonitor(ByVal Wb As Workbook)
    Const SM_CMONITORS = 80
    Dim dwData As uData
    Dim oNewWindow As Window
    
    If GetSystemMetrics(SM_CMONITORS) > 1 Then
        dwData.hOriginalWindow = Wb.Windows(1).hwnd
        Set oNewWindow = Wb.Windows(1).NewWindow
        dwData.hNewlWindow = oNewWindow.hwnd
        Call EnumDisplayMonitors(ByVal 0, ByVal 0, AddressOf Monitorenumproc, dwData)
    End If
End Sub
  
  
#If Win64 Then
    Function Monitorenumproc( _
        ByVal hMonitor As LongLong, _
        ByVal hDc As LongLong, _
        lpRect As RECT, _
        lParam As uData _
    ) As Long
#Else
    Function Monitorenumproc( _
        ByVal hMonitor As Long, _
        ByVal hDc As Long, _
        lpRect As RECT, _
        lParam As uData _
    ) As Long
#End If

    Const MONITOR_DEFAULTTONEAREST = &H2&
    Const SW_SHOWNORMAL = 1
    Dim uMI As MONITORINFO
    Dim uWP As WINDOWPLACEMENT
    
    uMI.cbSize = LenB(uMI)
    Call GetMonitorInfo(hMonitor, uMI)
    If MonitorFromWindow(lParam.hOriginalWindow, MONITOR_DEFAULTTONEAREST) <> hMonitor Then
        uWP.Length = Len(uWP)
        uWP.showCmd = SW_SHOWNORMAL
        Call SetWindowPlacement(lParam.hNewlWindow, uWP)
        With uMI.rcMonitor
            Call MoveWindow(lParam.hNewlWindow, .Left, .Top, .Right - .Left, .Bottom - .Top, True)
        End With
        Monitorenumproc = 0
    Else
        Monitorenumproc = 1
    End If
End Function
 
Upvote 0
Solution
Hi, this has been working really well for me.
I'm trying to run it from an add-in but get an error message (Run time error 9, Subscript out range).

The error is here.

1661870560254.png
 
Upvote 0
Hi, this has been working really well for me.
I'm trying to run it from an add-in but get an error message (Run time error 9, Subscript out range).

The error is here.

View attachment 72818

An addin is hidden from the user interface so it has no window or window handle.
You will need to pass an actual open workbook to the OpenNewWindowInSecondMonitor SUB.

For example, the following should open a new window of the active workbook in the second monitor:
OpenNewWindowInSecondMonitor ActiveWorkbook
 
Upvote 0
Thanks for looking into this. It does work now.
What you get are two windows, - 1 for the original and -2 for the new one.

I'm also trying to use another macro to close the second window.
This does close the window. But when your code is called up again, the second window has the title of "Excel" rather than "- 2".
Then the code below fails at the red line.
Also when it's closed the first time, the " -1" stays at the Title for the remaining window, when it would not be there if not run from an add-in.

VBA Code:
Private Sub Close_new_window()
    Dim Separator As String

    Separator = "  -  " 'Office 365
  
    'Close Window 2
    If ActiveWorkbook.Windows.Count > 1 Then
        [COLOR=rgb(226, 80, 65)]Windows(ActiveWorkbook.Name & Separator & 2).Activate[/COLOR]
        Windows(ActiveWorkbook.Name & Separator & 2).Close
    End If
  
    With ActiveWindow
        Application.WindowState = xlMaximized
    End With

End Sub

1661949227981.png
 
Last edited:
Upvote 0
Will you have in the second monitor, one single window open at a time or could there be a case where you have more than one window simultaneously opened in the second monitor ?
 
Upvote 0
Yes there could be more than 1 window if the are multiple files opened. I can see how it gets complicated.

Maybe it could save the name of the work book which was active when OpenNewWindowInSecondMonitor is called up.

The issue is there because when the second window is closed, there is a " -1" which stays at the Title for the remaining window even though the other one is now closed.
If second window is closed using the X close button in Excel, the " -1" is not there and there are no issues.

For reference, the reason for the macro is that there's other aspects after the new window, such as go this cell, freeze panes, maximise, etc. which I do all the time manually. Otherwise the normal command in Excel is OK.

1662003508511.png
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,405
Messages
6,171,925
Members
452,433
Latest member
Woodchuck76

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top