Auto Resize to fit different monitor sizes

Alan64

New Member
Joined
May 16, 2019
Messages
7
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
 
Last edited:

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,709
Wow, that's a lot of code.

How about this:

Code:
Sub Rezoom()
  Dim wsActive As Worksheet
  Set wsActive = ActiveSheet
  Dim ws As Worksheet
  For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    ws.UsedRange.Select
    ActiveWindow.Zoom = True
    ws.Range("A1").Select
  Next
  wsActive.Activate
End Sub
 

Forum statistics

Threads
1,078,541
Messages
5,341,061
Members
399,414
Latest member
EMW2159

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top