Adjusting worksheet zoom level based on screen resolution

Question

I have an Excel 2003 macro to adjust my screen zoom based on the screen resolution.

Sub Macro1()
   Dim maxWidth As Long, myWidth As Long
   Dim myZoom As Single

   maxWidth = Application.UsableWidth * 0.96
   'I use r because upto r i have macro buttons
   myWidth = ThisWorkbook.ActiveSheet.Range("r1").Left
   myZoom = maxWidth / myWidth
   ActiveWindow.Zoom = myZoom * 100
End Sub

When I try in Excel 2003, button size & its caption are not zooming properly. And Application.UsableWidth is always returning 1026 as width for either the screen resolution 1024*768 or 1366*768. Any ideas?

I want the Excel sheet to be fit in width if open in any system screen resolution

Answer 1

You can add this Windows API call to your code which can determine the screen resolution.

Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" _
 (ByVal nIndex As Long) As Long

  Sub Macro1()
    Dim maxWidth As Long
    Dim myWidth As Long
    Dim myZoom As Single

    maxWidth = GetSystemMetrics(0) * 0.96
    myWidth = ThisWorkbook.ActiveSheet.Range("R1").Left
    myZoom = maxWidth / myWidth
    ActiveWindow.Zoom = myZoom * 100

  End Sub