Hi - Could someone please give me bit of assistance, I am trying to get an excel document to auto resize to different monitor/screen sizes so bosses do not have to scroll around document. I have tried the code below but does not work (also not sure if putting in the right place, fairly new to this).I open the developer, this workbook and set to workbook open then paste code in. I am currently using window 7 and most of company has changed to windows 10(I will be shortly). Thanks for any help
<style>body,.top-bar{margin-top:1.9em}</style>
Sub Zoomitgood()
'this macro will loop through all thesheets and zoom to fit the contents by
'measuring the width andheight of each sheet. It will then zoom to 90% of
'the "zoom tofit" setting.
Dim WS_Count As Integer
Dim iAs Integer
Dim jAs Integer
Dim kAs Integer
Dimmaxwidth As Integer
Dimwidth As Integer
DimHeight As Integer
DimMaxHeight As Integer
Dimzoom As Integer
'First Loop: Loop through each sheet,select each sheet so that each width
'and height can bemeasured. The width and height are measured in number of
'cells.
WS_Count =ActiveWorkbook.Worksheets.Count
For i = 1To WS_Count
Worksheets(i).Activate
maxwidth = 0
MaxHeight = 0
'Second loop: measure the width ofeach sheet by running line by line and
'finding the rightmostcell. The maximum value of the rightmost cell will be
'set to the maxwidthvariable
For j = 1To 100
width = Cells(j, 100).End(xlToLeft).Column
If width >= maxwidth Then
maxwidth = width
End If
Next
'Third loop: measure the height ofeach sheet by running line by line and
'finding the rightmostcell. The maximum value of the lowest cell will be
'set to the maxheightvariable.
For k = 1To 100
Height = Cells(100, k).End(xlUp).Row
If Height >= MaxHeight Then
MaxHeight = Height
End If
Next
'Finally, back to loop 1, select therange for zooming. Then set the zoom to
'90% of full zoom.
Range(Cells(1, 1), Cells(MaxHeight, maxwidth)).Select
ActiveWindow.zoom = True
zoom = ActiveWindow.zoom
ActiveWindow.zoom = zoom * 0.9
Cells(1000, 1000).Select
Application.CutCopyMode = False
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next
MsgBox "You have been zoomed"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
<style>body,.top-bar{margin-top:1.9em}</style>
Sub Zoomitgood()
'this macro will loop through all thesheets and zoom to fit the contents by
'measuring the width andheight of each sheet. It will then zoom to 90% of
'the "zoom tofit" setting.
Dim WS_Count As Integer
Dim iAs Integer
Dim jAs Integer
Dim kAs Integer
Dimmaxwidth As Integer
Dimwidth As Integer
DimHeight As Integer
DimMaxHeight As Integer
Dimzoom As Integer
'First Loop: Loop through each sheet,select each sheet so that each width
'and height can bemeasured. The width and height are measured in number of
'cells.
WS_Count =ActiveWorkbook.Worksheets.Count
For i = 1To WS_Count
Worksheets(i).Activate
maxwidth = 0
MaxHeight = 0
'Second loop: measure the width ofeach sheet by running line by line and
'finding the rightmostcell. The maximum value of the rightmost cell will be
'set to the maxwidthvariable
For j = 1To 100
width = Cells(j, 100).End(xlToLeft).Column
If width >= maxwidth Then
maxwidth = width
End If
Next
'Third loop: measure the height ofeach sheet by running line by line and
'finding the rightmostcell. The maximum value of the lowest cell will be
'set to the maxheightvariable.
For k = 1To 100
Height = Cells(100, k).End(xlUp).Row
If Height >= MaxHeight Then
MaxHeight = Height
End If
Next
'Finally, back to loop 1, select therange for zooming. Then set the zoom to
'90% of full zoom.
Range(Cells(1, 1), Cells(MaxHeight, maxwidth)).Select
ActiveWindow.zoom = True
zoom = ActiveWindow.zoom
ActiveWindow.zoom = zoom * 0.9
Cells(1000, 1000).Select
Application.CutCopyMode = False
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next
MsgBox "You have been zoomed"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Last edited: