How to size window to fit cells (not Zoom)

[tbd]

Greetings,
I'd like to size the application window so that it only displays a
rectangular region of cells that I can define programmatically.

If there's not an easy way to specify the right-most and bottom-most visible
cell, then, is there a way to read a cell's pixel position?

The following commands may be relevant:
Application.Goto gWS_Calendar.Range("A1"), Scroll:=True
and
Application.Width = SomeNumberOfPixels
Application.Height = SomeNumberOfPixels

Thanks/Cheers!

 

[Peter T]

Sub AppSizeToRange()
Dim bW As Boolean, bH As Boolean
Dim diff As Single
Dim rng As Range
Dim rcMain As RECT, rcAW As RECT, rcRng As RECT

Set rng = Range("B4:J225") ' the range to size the app to

Set rng = rng.Resize(rng.Rows.Count + 1, rng.Columns.Count + 1)

Application.ScreenUpdating = False
Application.WindowState = xlMaximized
Application.ActiveWindow.WindowState = xlMaximized

Application.Goto rng(1), True

With rng
rcRng.W = .Width
rcRng.H = .Height
End With

With Application.ActiveWindow
rcAW.W = .Width
rcAW.H = .Height
End With

With Application
rcMain.W = .Width
rcMain.H = .Height
End With

bW = rcAW.W > rcRng.W
bH = rcAW.H > rcRng.H

If bW = False And bH = False Then
' rng too big
Exit Sub
End If

With Application
.WindowState = xlNormal
If bW Then
.Width = rcRng.W
diff = .Width - ActiveWindow.VisibleRange.Width
.Width = .Width + diff
diff = (.Left + .Width) - rcMain.W
If diff > 0 Then
.Left = .Left - diff
End If

Else
.Left = 0
.Width = rcMain.W
End If

If bH Then
.Height = rcRng.H
diff = .Height - ActiveWindow.VisibleRange.Height
.Height = .Height + diff
diff = (.Top + .Height) - rcMain.H
If diff > 0 Then
.Top = .Top - diff
End If
Else
.Top = 0
.Height = rcMain.H
End If

End With

errExit:
Application.ScreenUpdating = True
End Sub

Could also not show sheet tabs and scroll bars
In 2007 could minize the ribbon, or in earlier versions hide tool bars

Regards,
Peter T

 

[Barb Reinhardt]

This works, but I'd want to know where the actual calculation of the
multiplers for the height and width

Option Explicit

Sub test()
Dim aWS As Excel.Worksheet
Dim myRange As Excel.Range
Dim r As Excel.Range

Dim bRow As Long
Dim bCol As Long
Dim lRow As Long
Dim lCol As Long
Dim i As Long

Dim myRowHeight
Dim myColWidth

Set aWS = ActiveSheet
Set myRange = aWS.UsedRange

Debug.Print myRange.Address
'Start in top left

bRow = 1
bCol = 1
lCol = 0
lRow = 0

For Each r In myRange
If r.Column > lCol Then
lCol = r.Column
End If
If r.Row > lRow Then
lRow = r.Row
End If
Next r

'Determine column with for all columns

myColWidth = 0
Debug.Print bCol, lCol
For i = bCol To lCol
Debug.Print myColWidth, aWS.Columns(i).ColumnWidth
myColWidth = aWS.Columns(i).ColumnWidth + myColWidth

Next i

myRowHeight = 0
Debug.Print bRow, lRow
For i = bRow To lRow
Debug.Print myRowHeight, aWS.Rows(i).RowHeight
myRowHeight = aWS.Rows(i).RowHeight + myRowHeight
Next i
With ActiveWindow
.WindowState = xlNormal
'.Height = Application.UsableHeight
'.Width = Application.UsableWidth

'There has to be a better way to get to these multipliers, but I just
set the
'window to where I wanted it and calculated them from the
activewindow.height and width
'and my calculations

.Width = myColWidth * 6.66
.Height = myRowHeight * 1.55
End With
End Sub

HTH,
Barb Reinhardt

 

[tbd]

Hi Barb,
Great! Am learning a lot on this forum, but didn't have a good way to
organize coding tips&tricks until now. Your donation has prompted creation
of a "formal" code-snippet library!

Your warning re: multiplier is heeded. Worst case, this value is
derived from display hardware resolution, and that can be dealt with
(eventually.)

Thanks/Cheers!

 

[tbd]

Follow-up:
Not to diminish the value of Barb's solution -
here's another approach which defines a range then gets the pixel width of
the range object.
(credit to "EVERSTRIVIN", at www.excelforum.com)

Private Sub WorkSheet_Activate()
With Application
'.DisplayStatusBar = False
'.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
.ActiveWindow.WindowState = xlMaximized
.Goto ("R3C2"), True

'Range("B3").Select
.Width = Range("B3:R3").Width
lowest = 1
For i = 2 To 14 Step 3
If Cells(200, i).End(xlUp).Row > lowest Then
lowest = Cells(200, i).End(xlUp).Row
ElseIf Cells(200, i + 1).End(xlUp).Row Then
lowest = Cells(200, i + 1).End(xlUp).Row
End If
Next
.Height = Range("B3:B" & lowest + 1).Height + 74
End With
End Sub