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?
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
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.
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
Don't apologies, many thanks for your help, you have saved hours of individual sheet reviews.
*apologise
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