Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Adjusting worksheet zoom level based on screen resolution

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

like image 974
logan Avatar asked Jul 18 '12 03:07

logan


People also ask

Where is the zoom control located in Excel?

The keyboard shortcuts for Excel are: Zoom Out: CTRL + ALT + Minus Sign. Zoom In: CTRL + ALT + Plus Sign.

What is the maximum and minimum zoom in Excel?

By default, your window is displayed at 100% in MS Excel. However, excel extends the capability to change the zoom percentage from 10% (smallest window size) to 400% (largest size).


2 Answers

Sheets(1).Range("a1:AC1").Select
ActiveWindow.Zoom = True

Yes, this is all that's required. This will adjust the zoom level based on the screen resolution. Refer below link for detailed information :- http://optionexplicitvba.blogspot.sg/2011/10/one-size-fits-all.html

like image 56
user2598456 Avatar answered Sep 20 '22 12:09

user2598456


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
like image 33
Robert Mearns Avatar answered Sep 19 '22 12:09

Robert Mearns