Can I autofit worksheet contents to fit screen both horizontally and vertically?

I have a workbook containing a set of worksheets containing pivot tables of various sales stats.
I wish to output this workbook on a large lcd screen TV in the sales room so that the sales team can see their stats changing dynamically through the day. I need to find a way to optimize worksheet font size to the largest possible size (both horizontally and vertically) so as to ensure that the report contents are legible to everyone in the room. I have tried playing around with autozoom but have not managed to find an acceptable solution as yet. Can anyone help?
TV-Stats---DB1---DB3.xlsm
draesideAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

cyberkiwiCommented:
Hi there,

Excel is excellent at fitting to page - autozoom on printing. Instead of trying to tackle the spreadsheet, I would just do a print preview, set orientation to portrait/landscape as required.  Oh, of course set to fit 1x1.
0
patrickabCommented:
draeside,

Try using something like this:

With ActiveWindow
    .WindowState = xlNormal
    .Top = 1
    .Left = 1
    .Height = Application.UsableHeight
    .Width = Application.UsableWidth
End With

Patrick
0
draesideAuthor Commented:
Hi,
I had considered these options but what I want to do is make maximum use of the whole page each time so that the information is presented as clearly as possible to the whole office. With your solution (and other auto-zoom macros I have written) I can maximise horizontally but not vertically, which leaves unused space at the bottom of the page. The number of rows can change each time the pivot is refeshed so I need a solution that calulates the number of rows that need to be displayed and adjusts the row height and column width accordingly to fill up the entire screen.
0
cyberkiwiCommented:
Hi draeside,

I would have thought that zooming out to fit is harder.  That is covered by the link above.
Zooming in is a follow up to the code linked. Try the below:

It may be slow so let it settle to the right size on any new screen, then save the file once!
I could probably optimize it by gradually reducing the width/height adjustments and or zoom changes, but that's an exercise you can try.
Sub t()
'Assumed worksheets are not protected
'Fits in the screen according to used range columns

Dim sht As Worksheet
Dim x As Integer
    x = ActiveSheet.Index
    Application.ScreenUpdating = False
    For Each sht In ThisWorkbook.Worksheets
        sht.Activate
        sht.Columns.AutoFit
        sht.Rows.AutoFit
        ' first the columns
        If ActiveWindow.VisibleRange.Cells.Columns.Count > sht.UsedRange.Columns.Count Then
            Do Until ActiveWindow.VisibleRange.Cells.Columns.Count <= sht.UsedRange.Columns.Count
                If ActiveWindow.Zoom = 400 Then Exit Do
                ActiveWindow.Zoom = ActiveWindow.Zoom + 1
            Loop
        ElseIf ActiveWindow.VisibleRange.Cells.Columns.Count < sht.UsedRange.Columns.Count Then
            Do Until ActiveWindow.VisibleRange.Cells.Columns.Count >= sht.UsedRange.Columns.Count
                If ActiveWindow.Zoom = 10 Then Exit Sub
                ActiveWindow.Zoom = ActiveWindow.Zoom - 1
            Loop
        End If
        ' then the rows - but only zoom out not in
        If ActiveWindow.VisibleRange.Cells.Rows.Count < sht.UsedRange.Rows.Count Then
            Do Until ActiveWindow.VisibleRange.Cells.Rows.Count >= sht.UsedRange.Rows.Count
                If ActiveWindow.Zoom = 10 Then Exit Sub
                ActiveWindow.Zoom = ActiveWindow.Zoom - 1
            Loop
        End If
        ' finally resize columns and rows - not the zoom but the width/height
        Dim c As Integer, tmp As Double, tmp2 As Double
        c = 1
        If ActiveWindow.VisibleRange.Cells.Columns.Count > sht.UsedRange.Columns.Count Then
            Do Until ActiveWindow.VisibleRange.Cells.Columns.Count <= sht.UsedRange.Columns.Count
                tmp = ActiveSheet.Columns(c).ColumnWidth
                tmp2 = 0.2
                Do Until tmp < ActiveSheet.Columns(c).ColumnWidth
                    ActiveSheet.Columns(c).ColumnWidth = tmp + tmp2
                    tmp2 = tmp2 + 0.2
                Loop
                c = c + 1
                If c > sht.UsedRange.Columns.Count Then c = 1
            Loop
        End If
        If ActiveWindow.VisibleRange.Cells.Rows.Count > sht.UsedRange.Rows.Count Then
            Do Until ActiveWindow.VisibleRange.Cells.Rows.Count <= sht.UsedRange.Rows.Count
                tmp = ActiveSheet.Rows(c).RowHeight
                tmp2 = 0.05
                Do Until tmp < ActiveSheet.Rows(c).RowHeight
                    ActiveSheet.Rows(c).RowHeight = tmp + tmp2
                    tmp2 = tmp2 + 0.05
                Loop
                c = c + 1
                If c > sht.UsedRange.Rows.Count Then c = 1
            Loop
        End If
    Next sht
    ThisWorkbook.Sheets(x).Activate
    Application.ScreenUpdating = True

' --- new code follows

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.