New window, move to second screen (using VBA)

[Formula11]

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.

 

[Jaafar Tribak]

Which version of excel are you using ?

 

[Formula11]

Hi Jaafar, it's current 365 version I think.

 

[Jaafar Tribak]

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

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

 

[Formula11]

Thanks a lot Jaafar, this works really well.
Cheers.

 

[Formula11]

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.

 

[Jaafar Tribak]

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

 

[Formula11]

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.

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

 

[Jaafar Tribak]

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 ?

 

[Formula11]

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.