Check that all tabs are at 100% scaling

[RichJH]

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

 

[tyija1995]

Hey,

Try run this:

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

 

[RichJH]

Hey,

Try run this:

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?

 

[tyija1995]

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:

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.

 

[RichJH]

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.

 

[tyija1995]

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 %

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>

 

[RichJH]

Don't apologies, many thanks for your help, you have saved hours of individual sheet reviews.

 

[RichJH]

Don't apologies, many thanks for your help, you have saved hours of individual sheet reviews.

*apologise

 

[tyija1995]

*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

 

[Peter_SSs]

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 ..

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