Check that all tabs are at 100% scaling

RichJH

New Member
Joined
Sep 3, 2019
Messages
9
Hi,

I have multiple workbooks and would like to check that what the scaling is on each of the tabs before I print it out. Maybe some script that gives me a report tab maybe.

Thanks

Rich
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Hey,

Try run this:

Code:
Sub Zoom100()
Dim nSheets As Long, i As Long
nSheets = ActiveWorkbook.Sheets.Count
For i = 1 To nSheets
    Sheets(i).Activate
    ActiveWindow.Zoom = 100
Next i
End Sub
 
Upvote 0
Hey,

Try run this:

Code:
Sub Zoom100()
Dim nSheets As Long, i As Long
nSheets = ActiveWorkbook.Sheets.Count
For i = 1 To nSheets
    Sheets(i).Activate
    ActiveWindow.Zoom = 100
Next i
End Sub

Thanks, does that make all the tabs 100%? In my scenario some may not be 100% but would be okay i.e. supporting notes. Need ideally a report which lists tab name in column A and scaling setting in column B for a review?
 
Upvote 0
Thanks, does that make all the tabs 100%? In my scenario some may not be 100% but would be okay i.e. supporting notes. Need ideally a report which lists tab name in column A and scaling setting in column B for a review?

Hi, that will set all tab sizes to 100 yes, if you want a report tab that lists tab names in A and zoom status in B then try this:

Code:
Sub ZoomStatus()
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("MyZoomSummary").Delete
    Sheets.Add Before:=Sheets(1)
    Sheets(1).Name = "MyZoomSummary"
    Dim nSheets As Long, i As Long
    Sheets(1).Activate
    nSheets = ActiveWorkbook.Sheets.Count
        For i = 2 To nSheets
            Sheets(i).Activate
            Sheets(1).Cells(i - 1, 1).Value = Sheets(i).Name
            Sheets(1).Cells(i - 1, 2).Value = ActiveWindow.Zoom
        Next i
    Sheets(1).Activate
Application.DisplayAlerts = True
End Sub

WARNING: IN THE EXTREMELY UNLIKELY CASE THAT YOU HAVE A TAB PRIOR TO RUNNING THIS CALLED "MyZoomSummary" please change the name to something else! I highly doubt that this would be an issue though.
 
Upvote 0
This is brilliant, thank you for your time, but I need the Scaling-Adjust <XX>% normal size value in Page/Page Setup not the view zoom. What would this value be?

Thank you again.
 
Upvote 0
This is brilliant, thank you for your time, but I need the Scaling-Adjust <xx>% normal size value in Page/Page Setup not the view zoom. What would this value be?

Thank you again.

Oh, apologies! I took the page zoom not the page layout zoom %

Code:
Sub ZoomStatus()
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("MyZoomSummary").Delete
    Sheets.Add Before:=Sheets(1)
    Sheets(1).Name = "MyZoomSummary"
    Dim nSheets As Long, i As Long
    Sheets(1).Activate
    nSheets = ActiveWorkbook.Sheets.Count
        For i = 2 To nSheets
            Sheets(i).Activate
            Sheets(1).Cells(i - 1, 1).Value = Sheets(i).Name
            Sheets(1).Cells(i - 1, 2).Value = ActiveSheet.PageSetup.Zoom    'ActiveWindow.Zoom
        Next i
    Sheets(1).Activate
Application.DisplayAlerts = True
End Sub

I have commented out the ActiveWindow.Zoom - but that can be used to reference page zoom for future tasks should it be required :-)</xx>
 
Upvote 0
*apologise

Thanks for your feedback, glad I could help :-) FYI: You can use the macro recorder to generate a lot of the code, I've never dealt with Zoom until today - I made that code from using macro recorder and some basic VBA knowledge I have already :-) Have a good day
 
Upvote 0
A couple of comments.

- I don't think it is good practice to set On Error Resume Next & leave it on longer than necessary. It may hide other errors that you really want/need to know about

- Not at all important but you can add, place and name your new worksheet all at once.

- There is no need to activate each sheet to get its Name or PageSetup zoom. Remember that each activation slows your code & can sometimes make annoying screen flicker (unless ScreenUpdating is turned off)

So, a modified version of the code is ..
Code:
Sub Zoom_Status()
  Dim i As Long
  
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("MyZoomSummary").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  Sheets.Add(Before:=Sheets(1)).Name = "MyZoomSummary"
  For i = 2 To Sheets.Count
    Sheets(1).Cells(i - 1, 1).Value = Sheets(i).Name
    Sheets(1).Cells(i - 1, 2).Value = Sheets(i).PageSetup.Zoom
  Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top