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]

A couple of other questions:
1)- I notice you have the maximize Excel Window checkbox ticked prior to clicking the commandbutton . What happens if you leave the checkbox un-ticked?

2) Try selecting the current primary monitor from the combobox and fill the left and top textboxes with some values other than the defaul 0. Say you set the left to -200 pix and the top to 200 pix. Does the excel window now move to those screen positions?

 

[Handyman84]

Hi Jaafar yeah sorry must be difficult with one screen, the version I'm using is Microsoft® Excel® for Microsoft 365 MSO (Version 2305 Build 16.0.16501.20074) 64-bit

 

[Jaafar Tribak]

Hi Jaafar yeah sorry must be difficult with one screen, the version I'm using is Microsoft® Excel® for Microsoft 365 MSO (Version 2305 Build 16.0.16501.20074) 64-bit

So I take it that you are using Windows x64bit as well.
I will go through the code later on and see if there is a logic bug in it. As you said, w/o a second monitor for testing it is difficult to pinpoint the culprit.

What about the two questions I asked in my most recent post?

 

[Handyman84]

A couple of other questions:
1)- I notice you have the maximize Excel Window checkbox ticked prior to clicking the commandbutton . What happens if you leave the checkbox un-ticked?

2) Try selecting the current primary monitor from the combobox and fill the left and top textboxes with some values other than the defaul 0. Say you set the left to -200 pix and the top to 200 pix. Does the excel window now move to those screen positions?

Have just tried this see the screen record below, still no luck when having a look through the code is the userform definitely passing the display name over? I can see it loops through in MonitorName2HandleProc and was looking at the line dwData.MonitorHnwd = hMonitor is it something to do with this? I was trying to manually enter some values to PositionWindowOnMonitor and was trying to find a value to enter as hMonitor as the other values are easy enough, so was thinking is their a issue with the userform or is it in MonitorName2HandleProc? Yes is 64bit / VBA 7.1

https://imgur.com/T775eyv

 

[Handyman84]

So I take it that you are using Windows x64bit as well.
I will go through the code later on and see if there is a logic bug in it. As you said, w/o a second monitor for testing it is difficult to pinpoint the culprit.

What about the two questions I asked in my most recent post?

Also see this debug.print output think the issue is shown here for the MonitorLeftPix and MonitorTopPix returned values from within PositionWindowOnMonitor

https://imgur.com/mKQ1mQB

 

[Handyman84]

Hi Jaafar,

I've got this working here's the code:

Main Module

Option Explicit 
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long 
Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function MonitorFromRect Lib "user32.dll" (ByRef lprc As RECT, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Long 
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long 
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 

'https://answers.microsoft.com/en-us/msoffice/forum/all/detect-secondary-monitor-position/887b67de-8512-4883-81cb-52f9dea8226c

Private Const MONITORINFOF_PRIMARY = &H1
Private Const MONITOR_DEFAULTTONEAREST = &H2
Private Const MONITOR_DEFAULTTONULL = &H0
Private Const MONITOR_DEFAULTTOPRIMARY = &H1
Private Const MONITOR_CCHDEVICENAME As Long = 32

Private DebugInfo As Boolean

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
  szDevice As String * MONITOR_CCHDEVICENAME
End Type

Private Type POINT
  x As Long
  y As Long
End Type

'https://www.mrexcel.com/board/threads/new-window-move-to-second-screen-using-vba.1213373/post-6091193
#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Dim hWnd As Long

Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As LongPtr, lprcMonitor As RECT, ByVal dwData As Long) As Long
  
  Dim MI As MONITORINFO, R As RECT
  Dim ScreenName As String
  
  'initialize the MONITORINFO structure
  MI.cbSize = Len(MI)
  
  'Get the monitor information of the specified monitor
  GetMonitorInfo hMonitor, MI
  
  'Pass MONITORINFO
  If IsUserFormLoaded("SelectWindowMonitor") = True Then
    SelectWindowMonitor.ActiveScreen.Value = MI.szDevice
    ScreenName = SelectWindowMonitor.ActiveScreen.Value
  End If
  
  'Window Move
  If CBool(InStr(CStr(SelectWindowMonitor.ComboBox1.Value), ScreenName)) Then
    
    Dim MonitorLeftPos As Long: MonitorLeftPos = CLng(SelectWindowMonitor.TextBox1.Value) + MI.rcMonitor.Left
    Dim MonitorTopPos As Long: MonitorTopPos = CLng(SelectWindowMonitor.TextBox2.Value) + MI.rcMonitor.Top

    If CBool(InStr(LCase(SelectWindowMonitor.ComboBox1.Value), LCase(ScreenParameter("displayname", ThisWorkbook.Windows(1).hWnd)))) Then
        MsgBox "Excel already placed on selected screen " & SelectWindowMonitor.ComboBox1.Value & ", select another monitor.", vbOKOnly + vbInformation, "Monitor Already Active"
        Exit Function
    End If
    
    Application.WindowState = xlNormal
    Call MoveWindowOnMonitor(ActiveWindow.hWnd, hMonitor, MonitorLeftPos, MonitorTopPos)
    Application.WindowState = IIf(SelectWindowMonitor.CheckBox1.Value, xlMaximized, xlNormal)
    
    'Update new location of active window
    SelectWindowMonitor.ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd)
    
  End If
  
  If DebugInfo = False Then GoTo ContinueEnumeration
  
  'write some information
  Debug.Print "Monitor handle: " + CStr(hMonitor)
  Debug.Print "Monitor" & _
    " Display name " & MI.szDevice & vbNullChar & _
    " Left " & MI.rcMonitor.Left & _
    " Top  " & MI.rcMonitor.Top & _
    " Size " & MI.rcMonitor.Right - MI.rcMonitor.Left & "x" & MI.rcMonitor.Bottom - MI _
    .rcMonitor.Top
  Debug.Print "Primary monitor: " + CStr(CBool(MI.dwFlags = MONITORINFOF_PRIMARY))

  'check whether Form1 is located on this monitor
  If MonitorFromWindow(hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "hWnd is located on this monitor"
  End If

  'heck whether the point (0, 0) lies within the bounds of this monitor
  If MonitorFromPoint(0, 0, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "The point (0, 0) lies within the range of this monitor..."
  End If

  'check whether Form1 is located on this monitor
  GetWindowRect hWnd, R
  If MonitorFromRect(R, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "The rectangle of hWnd is within this monitor"
  End If

ContinueEnumeration:
'Continue enumeration
MonitorEnumProc = 1

End Function

Sub FindMonitorInfo(DebugWinInfo As Boolean)

   If DebugWinInfo Then DebugInfo = True

  'start the enumeration
  EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
  
End Sub
Public Sub MoveWindowOnMonitor( _
    ByVal hWnd As LongPtr, _
    ByVal hMonitor As LongPtr, _
    ByVal LeftPixel As Long, _
    ByVal TopPixel As Long _
)
    Const SWP_NOSIZE = &H1, SWP_SHOWWINDOW = &H40
    
    Call SetWindowPos(hWnd, NULL_PTR, LeftPixel, TopPixel, 0&, 0&, SWP_SHOWWINDOW + SWP_NOSIZE)
    
End Sub

Also reference to this slightly adapted module

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long 
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr 
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long 
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr 
Private Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal dwFlags As Long) As LongPtr 
Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean 
Private Declare PtrSafe Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As LongPtr) As LongPtr 
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long 

' https://wellsr.com/vba/2019/excel/calculate-ScreenParameter-size-and-other-display-details-with-vba/
' This module includes Private declarations for certain Windows API functions
' plus code for Public Function ScreenParameter, which returns metrics for the ScreenParameter displaying ActiveWindow
' This module requires VBA7 (Office 2010 or later)
' DEVELOPER: J. Woolley (for wellsr.com)

Private Const SM_CMONITORS              As Long = 80    ' number of display monitors
Private Const MONITOR_CCHDEVICENAME     As Long = 32    ' device name fixed length
Private Const MONITOR_PRIMARY           As Long = 1
Private Const MONITOR_DEFAULTTONULL     As Long = 0
Private Const MONITOR_DEFAULTTOPRIMARY  As Long = 1
Private Const MONITOR_DEFAULTTONEAREST  As Long = 2
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type MONITORINFOEX
   cbSize As Long
   rcMonitor As RECT
   rcWork As RECT
   dwFlags As Long
   szDevice As String * MONITOR_CCHDEVICENAME
End Type
Private Enum DevCap     ' GetDeviceCaps nIndex (video displays)
    HORZSIZE = 4        ' width in millimeters
    VERTSIZE = 6        ' height in millimeters
    HORZRES = 8         ' width in pixels
    VERTRES = 10        ' height in pixels
    BITSPIXEL = 12      ' color bits per pixel
    LOGPIXELSX = 88     ' horizontal DPI (assumed by Windows)
    LOGPIXELSY = 90     ' vertical DPI (assumed by Windows)
    COLORRES = 108      ' actual color resolution (bits per pixel)
    VREFRESH = 116      ' vertical refresh rate (Hz)
End Enum

Public Function ScreenParameter(Item As String, Optional ActiveWindowID As LongPtr) As Variant

' Return display ScreenParameter Item for monitor displaying ActiveWindow
' Patterned after Excel's built-in information functions CELL and INFO
' Supported Item values (each must be a string, but alphabetic case is ignored):
' HorizontalResolution or pixelsX
' VerticalResolution or pixelsY
' WidthInches or inchesX
' HeightInches or inchesY
' DiagonalInches or inchesDiag
' PixelsPerInchX or ppiX
' PixelsPerInchY or ppiY
' PixelsPerInch or ppiDiag
' WinDotsPerInchX or dpiX
' WinDotsPerInchY or dpiY
' WinDotsPerInch or dpiWin ' DPI assumed by Windows
' AdjustmentFactor or zoomFac ' adjustment to match actual size (ppiDiag/dpiWin)
' IsPrimary ' True if primary display
' DisplayName ' name recognized by CreateDC
' Update ' update cells referencing this UDF and return date/time
' Help ' display all recognized Item string values
' EXAMPLE: =ScreenParameter("pixelsX")
' Function Returns #VALUE! for invalid Item
    Dim xHSizeSq As Double, xVSizeSq As Double, xPix As Double, xDot As Double
    Dim hWnd As LongPtr, hdc As LongPtr, hMonitor As LongPtr
    Dim tMonitorInfo As MONITORINFOEX
    Dim nMonitors As Integer
    Dim vResult As Variant
    Dim sItem As String
    Application.Volatile
    nMonitors = GetSystemMetrics(SM_CMONITORS)
    
    If nMonitors < 2 Then
        nMonitors = 1                                       ' in case GetSystemMetrics failed
        hWnd = 0
    Else
        If ActiveWindowID <> 0 Then
            hWnd = ActiveWindowID
        Else
            hWnd = GetActiveWindow()
        End If
        
        hMonitor = MonitorFromWindow(hWnd, MONITOR_DEFAULTTONULL)
        If hMonitor = 0 Then
            Debug.Print "ActiveWindow does not intersect a monitor"
            hWnd = 0
        Else
            tMonitorInfo.cbSize = Len(tMonitorInfo)
            If GetMonitorInfo(hMonitor, tMonitorInfo) = False Then
                Debug.Print "GetMonitorInfo failed"
                hWnd = 0
            Else
                hdc = CreateDC(tMonitorInfo.szDevice, 0, 0, 0)
                If hdc = 0 Then
                    Debug.Print "CreateDC failed"
                    hWnd = 0
                End If
            End If
        End If
    End If
    If hWnd = 0 Then
    
        If ActiveWindowID <> 0 Then
        hdc = GetDC(ActiveWindowID) 'XL_Screen
        Else
        hdc = GetDC(hWnd)
        End If
        
        tMonitorInfo.dwFlags = MONITOR_PRIMARY
        tMonitorInfo.szDevice = "PRIMARY" & vbNullChar
    End If
    sItem = Trim(LCase(Item))
    Select Case sItem
    Case "horizontalresolution", "pixelsx"                  ' HorizontalResolution (pixelsX)
        vResult = GetDeviceCaps(hdc, DevCap.HORZRES)
    Case "verticalresolution", "pixelsy"                    ' VerticalResolution (pixelsY)
        vResult = GetDeviceCaps(hdc, DevCap.VERTRES)
    Case "widthinches", "inchesx"                           ' WidthInches (inchesX)
        vResult = GetDeviceCaps(hdc, DevCap.HORZSIZE) / 25.4
    Case "heightinches", "inchesy"                          ' HeightInches (inchesY)
        vResult = GetDeviceCaps(hdc, DevCap.VERTSIZE) / 25.4
    Case "diagonalinches", "inchesdiag"                     ' DiagonalInches (inchesDiag)
        vResult = Sqr(GetDeviceCaps(hdc, DevCap.HORZSIZE) ^ 2 + GetDeviceCaps(hdc, DevCap.VERTSIZE) ^ 2) / 25.4
    Case "pixelsperinchx", "ppix"                           ' PixelsPerInchX (ppiX)
        vResult = 25.4 * GetDeviceCaps(hdc, DevCap.HORZRES) / GetDeviceCaps(hdc, DevCap.HORZSIZE)
    Case "pixelsperinchy", "ppiy"                           ' PixelsPerInchY (ppiY)
        vResult = 25.4 * GetDeviceCaps(hdc, DevCap.VERTRES) / GetDeviceCaps(hdc, DevCap.VERTSIZE)
    Case "pixelsperinch", "ppidiag"                         ' PixelsPerInch (ppiDiag)
        xHSizeSq = GetDeviceCaps(hdc, DevCap.HORZSIZE) ^ 2
        xVSizeSq = GetDeviceCaps(hdc, DevCap.VERTSIZE) ^ 2
        xPix = GetDeviceCaps(hdc, DevCap.HORZRES) ^ 2 + GetDeviceCaps(hdc, DevCap.VERTRES) ^ 2
        vResult = 25.4 * Sqr(xPix / (xHSizeSq + xVSizeSq))
    Case "windotsperinchx", "dpix"                          ' WinDotsPerInchX (dpiX)
        vResult = GetDeviceCaps(hdc, DevCap.LOGPIXELSX)
    Case "windotsperinchy", "dpiy"                          ' WinDotsPerInchY (dpiY)
        vResult = GetDeviceCaps(hdc, DevCap.LOGPIXELSY)
    Case "windotsperinch", "dpiwin"                         ' WinDotsPerInch (dpiWin)
        xHSizeSq = GetDeviceCaps(hdc, DevCap.HORZSIZE) ^ 2
        xVSizeSq = GetDeviceCaps(hdc, DevCap.VERTSIZE) ^ 2
        xDot = GetDeviceCaps(hdc, DevCap.LOGPIXELSX) ^ 2 * xHSizeSq + GetDeviceCaps(hdc, DevCap.LOGPIXELSY) ^ 2 * xVSizeSq
        vResult = Sqr(xDot / (xHSizeSq + xVSizeSq))
    Case "adjustmentfactor", "zoomfac"                      ' AdjustmentFactor (zoomFac)
        xHSizeSq = GetDeviceCaps(hdc, DevCap.HORZSIZE) ^ 2
        xVSizeSq = GetDeviceCaps(hdc, DevCap.VERTSIZE) ^ 2
        xPix = GetDeviceCaps(hdc, DevCap.HORZRES) ^ 2 + GetDeviceCaps(hdc, DevCap.VERTRES) ^ 2
        xDot = GetDeviceCaps(hdc, DevCap.LOGPIXELSX) ^ 2 * xHSizeSq + GetDeviceCaps(hdc, DevCap.LOGPIXELSY) ^ 2 * xVSizeSq
        vResult = 25.4 * Sqr(xPix / xDot)
    Case "isprimary"                                        ' IsPrimary
        vResult = CBool(tMonitorInfo.dwFlags And MONITOR_PRIMARY)
    Case "displayname"                                      ' DisplayName
        vResult = tMonitorInfo.szDevice & vbNullChar
        vResult = Left(vResult, (InStr(1, vResult, vbNullChar) - 1))
    Case "displayleft"
        vResult = tMonitorInfo.rcMonitor.Left
    Case "displaytop"
        vResult = tMonitorInfo.rcMonitor.Top
    Case "update"                                           ' Update
        vResult = Now
    Case "help"                                             ' Help
        vResult = "HorizontalResolution (pixelsX), VerticalResolution (pixelsY), " _
            & "WidthInches (inchesX), HeightInches (inchesY), DiagonalInches (inchesDiag), " _
            & "PixelsPerInchX (ppiX), PixelsPerInchY (ppiY), PixelsPerInch (ppiDiag), " _
            & "WinDotsPerInchX (dpiX), WinDotsPerInchY (dpiY), WinDotsPerInch (dpiWin), " _
            & "AdjustmentFactor (zoomFac), IsPrimary, DisplayName, Update, Help"
    Case Else                                               ' Else
        vResult = CVErr(xlErrValue)                         ' return #VALUE! error (2015)
    End Select
    If hWnd = 0 Then
        ReleaseDC hWnd, hdc
    Else
        DeleteDC hdc
    End If
    ScreenParameter = vResult
End Function

Userform - Note Changes added a label called ActiveMonitor

Option Explicit

Private Sub UserForm_Initialize()

    With SelectWindowMonitor
     .Height = 190
     .width = 180
     .ComboBox1.list = GetMonitorsNames
     .ComboBox1.Value = Me.ComboBox1.list(0)
     .TextBox1 = 0&: TextBox2 = 0&
     .CheckBox1.Value = True
     .ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd)
    
    'PURPOSE: Position userform to center of Excel Window (important for dual monitor compatibility)
    'Start Userform Centered inside Excel Screen (for dual monitors)
    .StartUpPosition = 0
    .Left = Application.Left + (0.5 * Application.width) - (0.5 * Me.width)
    .Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)

    End With
    
End Sub

Private Sub CommandButton1_Click()

Call FindMonitorInfo(False)
    
End Sub

 

[Jaafar Tribak]

Hey Handyman84

Happy you got this working and thanks for posting the solution... I am going to take a look at the code and let you know.

Regards.

 

[Handyman84]

Hi Jaafar,

I've further tweaked this only relies on one module being the main code module and the userform.

Main Module: WindowMultiScreenInfo

Option Explicit 
Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long 
Private Declare PtrSafe Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function MonitorFromRect Lib "user32.dll" (ByRef lprc As RECT, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long 
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As LongPtr, ByRef lprcClip As Any, ByVal lpfnEnum As LongPtr, ByVal dwData As LongPtr) As Long 
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long 
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 

'https://answers.microsoft.com/en-us/msoffice/forum/all/detect-secondary-monitor-position/887b67de-8512-4883-81cb-52f9dea8226c

Private Const MONITORINFOF_PRIMARY = &H1
Private Const MONITOR_DEFAULTTONEAREST = &H2
Private Const MONITOR_DEFAULTTONULL = &H0
Private Const MONITOR_DEFAULTTOPRIMARY = &H1
Private Const MONITOR_CCHDEVICENAME As Long = 32

Private MonitorAction As String

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
  szDevice As String * MONITOR_CCHDEVICENAME
End Type

Private Type POINT
  x As Long
  y As Long
End Type

'https://www.mrexcel.com/board/threads/new-window-move-to-second-screen-using-vba.1213373/post-6091193
#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Dim hWnd As Long

Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As LongPtr, lprcMonitor As RECT, ByVal dwData As Long) As Long
  
  Dim MI As MONITORINFO, R As RECT
  Dim ScreenName As String
  Dim DisplayID As String
  Dim ActiveMonitor As Boolean
  
  'initialize the MONITORINFO structure
  MI.cbSize = Len(MI)
  
  'Get the monitor information of the specified monitor
  GetMonitorInfo hMonitor, MI
  
  Select Case MonitorAction
  
  Case "Move Window"
  
  'Pass MONITORINFO
  If IsUserFormLoaded("SelectWindowMonitor") = True Then
    SelectWindowMonitor.ActiveScreen.Value = MI.szDevice
    ScreenName = SelectWindowMonitor.ActiveScreen.Value
  End If
  
  'Window Move
  If CBool(InStr(CStr(SelectWindowMonitor.ComboBox1.Value), ScreenName)) Then
    
    'Avoids error if offset is blank
    With SelectWindowMonitor
    If .TextBox1.Value = "" Then .TextBox1.Value = 0
    If .TextBox2.Value = "" Then .TextBox2.Value = 0
    End With
    
    Dim MonitorLeftPos As Long: MonitorLeftPos = CLng(SelectWindowMonitor.TextBox1.Value) + MI.rcMonitor.Left
    Dim MonitorTopPos As Long: MonitorTopPos = CLng(SelectWindowMonitor.TextBox2.Value) + MI.rcMonitor.Top
    
    Select Case True
        Case CBool(MI.dwFlags = MONITORINFOF_PRIMARY) And CBool(MI.dwFlags = MONITORINFOF_PRIMARY) = True And CBool(MonitorFromWindow(ActiveWindow.hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor) = True: ActiveMonitor = True
        Case CBool(MonitorFromWindow(ActiveWindow.hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor) And CBool(MI.dwFlags = MONITORINFOF_PRIMARY) = False: ActiveMonitor = True
        Case Else: ActiveMonitor = False
    End Select
    
    If ActiveMonitor = True Then
        MsgBox "Excel already placed on selected screen " & SelectWindowMonitor.ComboBox1.Value & ", select another monitor.", vbOKOnly + vbInformation, "Monitor Already Active"
        Exit Function
    End If
    
    Application.WindowState = xlNormal
    Call MoveWindowToMonitor(ActiveWindow.hWnd, hMonitor, MonitorLeftPos, MonitorTopPos)
    Application.WindowState = IIf(SelectWindowMonitor.CheckBox1.Value, xlMaximized, xlNormal)
    
  End If
  
  
  Case "Add Display Names"
  
  'Loads combobox values
    With SelectWindowMonitor
    
    'Assign Active Display Value
    .ActiveScreen.Value = MI.szDevice & vbNullChar
    DisplayID = .ActiveScreen.Value
    
        Select Case True
        Case CBool(MI.dwFlags = MONITORINFOF_PRIMARY) And CBool(MI.dwFlags = MONITORINFOF_PRIMARY) = True And CBool(MonitorFromWindow(ActiveWindow.hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor) = False: DisplayID = DisplayID & " [Primary Monitor]"
        Case CBool(MI.dwFlags = MONITORINFOF_PRIMARY) And CBool(MI.dwFlags = MONITORINFOF_PRIMARY) = True And CBool(MonitorFromWindow(ActiveWindow.hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor) = True: DisplayID = DisplayID & " [Primary Active]"
        Case CBool(MonitorFromWindow(ActiveWindow.hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor) And CBool(MI.dwFlags = MONITORINFOF_PRIMARY) = False: DisplayID = DisplayID & " [Active Monitor]"
        Case Else: DisplayID = DisplayID
        End Select
    
    'Add Values
    .ComboBox1.AddItem DisplayID
    
  End With
  
  Case "Debug Monitor Info"
  
  'write some information
  Debug.Print "Monitor handle: " + CStr(hMonitor)
  Debug.Print "Monitor" & _
    " Display name " & MI.szDevice & vbNullChar & _
    " Left " & MI.rcMonitor.Left & _
    " Top  " & MI.rcMonitor.Top & _
    " Size " & MI.rcMonitor.Right - MI.rcMonitor.Left & "x" & MI.rcMonitor.Bottom - MI _
    .rcMonitor.Top
  Debug.Print "Primary monitor: " + CStr(CBool(MI.dwFlags = MONITORINFOF_PRIMARY))

  'check whether Form1 is located on this monitor
  If MonitorFromWindow(hWnd, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "hWnd is located on this monitor"
  End If

  'heck whether the point (0, 0) lies within the bounds of this monitor
  If MonitorFromPoint(0, 0, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "The point (0, 0) lies within the range of this monitor..."
  End If

  'check whether Form1 is located on this monitor
  GetWindowRect hWnd, R
  If MonitorFromRect(R, MONITOR_DEFAULTTONEAREST) = hMonitor Then
    Debug.Print "The rectangle of hWnd is within this monitor"
  End If
  
  End Select


ContinueEnumeration:
'Continue enumeration
MonitorEnumProc = 1

End Function

Sub FindMonitorInfo(MonitorOutput As String)
    
Select Case MonitorOutput

Case "Move Window": MonitorAction = MonitorOutput
Case "Add Display Names": MonitorAction = MonitorOutput 'Loop Monitors
Case "Debug Monitor Info": MonitorAction = MonitorOutput

End Select

'start the enumeration
EnumDisplayMonitors ByVal 0&, ByVal 0&, AddressOf MonitorEnumProc, ByVal 0&
  
End Sub
Sub MoveWindowToMonitor( _
    ByVal hWnd As LongPtr, _
    ByVal hMonitor As LongPtr, _
    ByVal LeftPixel As Long, _
    ByVal TopPixel As Long _
)
    Const SWP_NOSIZE = &H1, SWP_SHOWWINDOW = &H40
 
    'LeftPixel = LeftPixel + MonitorLeftPix(hMonitor)
    'TopPixel = TopPixel + MonitorTopPix(hMonitor)
    
    Call SetWindowPos(hWnd, NULL_PTR, LeftPixel, TopPixel, 0&, 0&, SWP_SHOWWINDOW + SWP_NOSIZE)
    
End Sub

Userform: SelectWindowMonitor

Note Textbox ActiveScreen is hidden to allow values to be passed around.

Option Explicit

Private Sub CheckBox1_Click()

With SelectWindowMonitor

If .CheckBox1.Value = True Then
    .TextBox1.Enabled = False
    .TextBox2.Enabled = False
    .TextBox1.Value = 0
    .TextBox2.Value = 0
Else
    .TextBox1.Enabled = True
    .TextBox2.Enabled = True
End If

End With

End Sub

Private Sub TextBox1_Change()

Call TextBoxOffSetPix

End Sub


Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    
HighlightTB SelectWindowMonitor.TextBox1

End Sub
Sub HighlightTB(tb As MSForms.TextBox)

        With tb
            .SelStart = 0
            .SelLength = Len(.text)
        End With

End Sub
Private Sub TextBox2_Change()

Call TextBoxOffSetPix

End Sub

Sub TextBoxOffSetPix()

With SelectWindowMonitor
    
    If .TextBox1.Value = "" Or Me.TextBox2.Value = "" Then
        .CheckBox1.Enabled = True
        .CheckBox1.Value = True
        .TextBox1.Enabled = False
        .TextBox2.Enabled = False
        .TextBox1.Value = 0
        .TextBox2.Value = 0
    ElseIf .TextBox1.Value <> 0 Or Me.TextBox2.Value <> 0 And (IsNumeric(.TextBox1.Value) And IsNumeric(.TextBox2.Value)) Then
        .CheckBox1.Value = False
        .CheckBox1.Enabled = False
        .TextBox1.Enabled = True
        .TextBox2.Enabled = True
    Else
        .CheckBox1.Enabled = True
    End If
End With


End Sub


Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
HighlightTB SelectWindowMonitor.TextBox2
End Sub

Private Sub UserForm_Initialize()

    With SelectWindowMonitor
     .Height = 190
     .width = 180
     '.ComboBox1.list = GetMonitorsNames
     '.ComboBox1.Value = Me.ComboBox1.list(0)
     
     Call FindMonitorInfo("Add Display Names") 'Populates Combobox
     
     .TextBox1 = 0
     .TextBox2 = 0
     .CheckBox1.Value = True
     .ComboBox1.Value = Me.ComboBox1.list(0)
     
     If get_primary(Me.ComboBox1, CStr(ScreenParameter("displayname", ActiveWindow.hWnd))) Then
        .ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd) & " [Primary]"
     Else
          .ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd)
     End If
     
     .Caption = "Move Excel To Monitor"
     
     'Applying directly from MonitorNamesEnumProc
     'Call ComboUpdater
    
    'PURPOSE: Position userform to center of Excel Window (important for dual monitor compatibility)
    'Start Userform Centered inside Excel Screen (for dual monitors)
    .StartUpPosition = 0
    .Left = Application.Left + (0.5 * Application.width) - (0.5 * Me.width)
    .Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)

    End With
    
End Sub
Sub ComboUpdater()

'Reload Combo values with Active Screen
Dim new_values()
Dim x As Long

get_primaryModify Me.ComboBox1, new_values

End Sub
Private Sub CommandButton1_Click()

'Moves the window to new screen
Call FindMonitorInfo("Move Window")

'Do Userform Updates when combobox changed

'Reset Combobox Text
With SelectWindowMonitor
.ComboBox1.Clear
Call FindMonitorInfo("Add Display Names") 'Populates Combobox
.ComboBox1.Value = Me.ComboBox1.list(0)
End With

'Applying directly from MonitorNamesEnumProc
'Call ComboUpdater

'Update Captions

'Update new location of active window to status text label
With SelectWindowMonitor
    If get_primary(.ComboBox1, CStr(ScreenParameter("displayname", ActiveWindow.hWnd))) Then
        .ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd) & " [Primary]"
    Else
        .ActiveMonitor.Caption = "Active Monitor: " & ScreenParameter("displayname", ActiveWindow.hWnd)
    End If
End With
    
End Sub