You could also do an auto calculation of pixels to points...
I wrote this for auto-dual screening excel, making the first 2 workbooks resized to each monitor. I have 2 different sized monitors and needed it to calculate the sizes, and I had planned this for distribution, some people had 2 of the same, and other people had Large fonts turned on (which changes the DPI and therefore the pix->pts ratio).
It is designed as part of an add-in and references ThisWorkbook to hold some variables for toggle functionality (like which screen Excel was on before this was activated.. etc)
-Declare
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Public Sub DualScreen()
'References
'
'
Dim MidScreen As Double, AppLocLeft As Double, AppLocHeight As Double, AppLocWidth As Double, StrtLoc As Double
Dim PriWidth As Double, SecWidth As Double, MaxPtWidth As Double, MaxPtHeight As Double, SmallHeight As Double, MinWidth As Double
Dim Px As Long, Py As Long, Vx As Long, Vy As Long
Dim NumMonFactor As Variant
'Get monitor sizes in Pixels
Px = GetSystemMetrics(0) 'Primary screen x
Py = GetSystemMetrics(1) 'Primary screen y
Vx = GetSystemMetrics(78) 'Virtual screen x
Vy = GetSystemMetrics(79) 'Virtual screen y
'Gets the DPI settings and calculates Pt to Px conversion factor
hDC = GetDC(0)
PtPx = 72 / GetDeviceCaps(hDC, 88)
'Calculate Screen Points
PriWidth = Px * PtPx
SecWidth = (Vx - Px) * PtPx
MaxPtWidth = Vx * PtPx
If Py > Vy Then
SmallHeight = Vy * PtPx - 50 'compensate for taskbar
MaxPtHeight = Py * PtPx
Else
SmallHeight = Py * PtPx - 50
MaxPtHeight = Vy * PtPx
End If
If ThisWorkbook.Worksheets(1).Range("B5").Value = "" Then
ThisWorkbook.Worksheets(1).Range("B5").Value = False
End If
If GetSystemMetrics(80) = 1 Then
'You do not have Dual Monitors, so we'll split your screen
NumMonFactor = 2
Else
NumMonFactor = 1
End If
Select Case ThisWorkbook.Worksheets(1).Range("B5").Value
Case True
Select Case ThisWorkbook.Worksheets(1).Range("B6").Value
Case Is > PriWidth
StrtLoc = PriWidth + (SecWidth / 2)
MinWidth = SecWidth
Case Is < PriWidth
StrtLoc = 0
MinWidth = PriWidth
End Select
'Restore to single monitor
With Application
.WindowState = xlNormal
.Left = StrtLoc
.Width = MinWidth
.WindowState = xlMaximized
On Error Resume Next
.ActiveWindow.WindowState = xlMaximized
End With
'Set the Dual indicator
ThisWorkbook.Worksheets(1).Range("B5").Value = False
Case False
'Current Visual settings
'+100 to the left value to compensate for minor graphical calculation when restoring from Maximized
ThisWorkbook.Worksheets(1).Range("B6").Value = Application.Left + 100
'Apply Dual Screen
With Application
.WindowState = xlNormal
.Left = 0
.Top = 0
.Width = MaxPtWidth
.Height = SmallHeight
End With
ArrangeTile
On Error Resume Next
'Restructure the first 2 workbooks to fit the screens
Application.Windows(1).Width = (PriWidth / NumMonFactor)
With Application.Windows(2)
.Left = Application.Windows(1).Width + 1
.Width = SecWidth
End With
'Set the Dual indicator
ThisWorkbook.Worksheets(1).Range("B5").Value = True
End Select
End Sub
