Dual monitors How to have userform open on other monitor then main excel?

[jonmelmo]

When searching I keep finding this code or examples that centers the userForm on the excel window that is open. I want to keep the excel window on 1 screen and have it open the userform on the other monitor of a duel monitor set up. Does any one have suggestions?

Private Sub HighlightForm_Activate()

With HighlightForm
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
.Show
End With

End Sub

 

[6StringJazzer]

I use two monitors. My main monitor is on the left and #2 monitor is on the right. This code opens the userform in the middle of the right monitor. You will have to experiment with numbers that put it where you want it.

BTW the name of your sub is wrong. It will not be called.

Private Sub UserForm_Activate()

   With Me
      Me.Left = 2000
      Me.Top = 250
   End With
   
End Sub

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Dual monitors How to have userform open on other monitor then main excel? - OzGrid Free Excel/VBA Help Forum

When searching I keep finding this code or examples that centers the userForm on the excel window that is open. I want to keep the excel window on 1 screen and have it open the userform on the other monitor of a duel monitor set up. Does any one have…

forum.ozgrid.com

If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[CubaRJ]

I use two monitors. My main monitor is on the left and #2 monitor is on the right. This code opens the userform in the middle of the right monitor. You will have to experiment with numbers that put it where you want it.

BTW the name of your sub is wrong. It will not be called.

Private Sub UserForm_Activate()

   With Me
      Me.Left = 2000
      Me.Top = 250
   End With
 
End Sub

Hi, I have found a long time ago this piece of code, I can´t remember where nor who to credit it for:

Place this in a standard module:

Option Explicit
#If VBA7 Then
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#Else
    Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
    Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#End If

Type udtRECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long

Public Sub ReturnPosition_CenterScreen(ByVal sngHeight As Single, _
                                       ByVal sngWidth As Single, _
                                       ByRef sngLeft As Single, _
                                       ByRef sngTop As Single)
Dim sngAppWidth As Single
Dim sngAppHeight As Single
Dim hWnd As Long
Dim lreturn As Long
Dim lpRect As udtRECT

    hWnd = Application.hWnd   'Used in Excel and Word
    'hWnd = Application.hWndAccessApp  'Used in Access
   
    lreturn = GetWindowRect(hWnd, lpRect)
    sngAppWidth = ConvertPixelsToPoints(lpRect.Right - lpRect.Left, "X")
    sngAppHeight = ConvertPixelsToPoints(lpRect.Bottom - lpRect.Top, "Y")
    sngLeft = ConvertPixelsToPoints(lpRect.Left, "X") + ((sngAppWidth - sngWidth) / 2)
    sngTop = ConvertPixelsToPoints(lpRect.Top, "Y") + ((sngAppHeight - sngHeight) / 2)
End Sub

Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, _
                                      ByVal sXorY As String) As Single
Dim hDC As Long

   hDC = GetDC(0)
   If sXorY = "X" Then
      ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))
   End If
   If sXorY = "Y" Then
      ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))
   End If
   Call ReleaseDC(0, hDC)
End Function
Sub StartCode()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

End Type

Then you can paste this to every Initialize event of your forms:

Private Sub UserForm_Initialize()
Dim sngLeft As Single, sngTop As Single
    Call ReturnPosition_CenterScreen(Me.Height, Me.Width, sngLeft, sngTop): Me.Left = sngLeft: Me.Top = sngTop

End Sub

Hope it helps you!

 

[Gokhan Aycan]

@CubaRJ Your End Type for udtRECT seems to be at the wrong place?

Edit: Sub StartCode doesn't look like a part of the rest.

 

[CubaRJ]

@CubaRJ Your End Type for udtRECT seems to be at the wrong place?

Edit: Sub StartCode doesn't look like a part of the rest.

You are right! I pasted it by mistake. The same for end type.

This is the correct code.

Although I have tested it and it seems to only open on your active window and center the userform accordingly to your monitor size.

Option Explicit
#If VBA7 Then
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#Else
    Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
    Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#End If

Type udtRECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long

Public Sub ReturnPosition_CenterScreen(ByVal sngHeight As Single, _
                                       ByVal sngWidth As Single, _
                                       ByRef sngLeft As Single, _
                                       ByRef sngTop As Single)
Dim sngAppWidth As Single
Dim sngAppHeight As Single
Dim hWnd As Long
Dim lreturn As Long
Dim lpRect As udtRECT

    hWnd = Application.hWnd   'Used in Excel and Word
    'hWnd = Application.hWndAccessApp  'Used in Access
 
    lreturn = GetWindowRect(hWnd, lpRect)
    sngAppWidth = ConvertPixelsToPoints(lpRect.Right - lpRect.Left, "X")
    sngAppHeight = ConvertPixelsToPoints(lpRect.Bottom - lpRect.Top, "Y")
    sngLeft = ConvertPixelsToPoints(lpRect.Left, "X") + ((sngAppWidth - sngWidth) / 2)
    sngTop = ConvertPixelsToPoints(lpRect.Top, "Y") + ((sngAppHeight - sngHeight) / 2)
End Sub

Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, _
                                      ByVal sXorY As String) As Single
Dim hDC As Long

   hDC = GetDC(0)
   If sXorY = "X" Then
      ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))
   End If
   If sXorY = "Y" Then
      ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))
   End If
   Call ReleaseDC(0, hDC)
End Function