Getting users screen aspect ratio vba excel

Question

I've designed a tool in excel for multiple users to use. When I open the tool on my monitor it fits perfectly to the screen. I've done this by simply zooming to a range:

Sheets("sliders").Activate
Range("A1:BA51").Select
Range("A51").Activate
ActiveWindow.Zoom = True

I was wondering if anyone knows of a better way of doing this. Some users have said that the tool cuts off sections at the sides and top? I guess this is because the aspect ration of their monitor is different to mine.

Is there any way you can access this kind of information using VBA in excel? I could make cases for different type of screens if this was the case.

Answer 1

For autofitting i usually use this:

on your worksheet highlight the entire range of cells you want to display Go to the Insert Menu, and choose "Name" and then "Define" Name the range you've highlighted "ResizeRange"

Then in VBA choose "ThisWorkbook" and paste the following code:

Private Sub Workbook_Open()
range("ResizeRange").select
ActiveWindow.Zoom = True
cells(1,1).select
end sub

If you wan't to go a step further u can also remove all ribbons etc. so you visually only can see your spreadsheat. then do the following

In thisworkbook :

Sub Workbook_Open()
Application.EnableEvents = False
Call masque
Application.EnableEvents = True
End Sub

Sub Workbook_Activate()
Application.EnableEvents = False
Call masque
Application.EnableEvents = True
End Sub

Sub Workbook_Deactivate()
Application.EnableEvents = False
Call normal
Application.EnableEvents = True
End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = False
Call normal
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

In module1:

Sub masque()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
Application.DisplayFullScreen = True
Application.DisplayStatusBar = Not Application.DisplayStatusBar
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
Application.DisplayFormulaBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

In module2:

Sub normal()
Application.ScreenUpdating = False
ActiveWindow.View = xlNormalView
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = True
Application.DisplayStatusBar = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
'Curiously, if we put the previous line at the beginning of the module, it     is not taken into account each time ...
Application.ScreenUpdating = True
End Sub

In each sheet :

Sub Worksheet_Open()
Call masque
End Sub

Sub Worksheet_Activate()
Application.ScreenUpdating = False
Call masque 
Application.ScreenUpdating = True
End Sub

this removes everything and upon closing it puts it all back so if you open an excel file it will look normal again.

in worksheet_activate and worksheet_open you can add the following line to make sure that one cant scroll and your info stay in screen all the time.

me.scrollarea = resizerange

Answer 2

Try this:

Declare Function GetSystemMetrics32 Lib "User32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Sub FindResolution()
Dim w As Long, h As Long
    w = GetSystemMetrics32(0) ' width in pixels
    h = GetSystemMetrics32(1) ' height in pixels
    MsgBox w & Chr(10) & h, vbOKOnly + vbInformation, "Monitor Size (width x height)"


End Sub