TYPO !
in LastDcell() change
dR = .Find("*", .Range("A1"), xlFormulas, xlPart, _
xlByColumns, SrchDir, 0).Row
to
dR = .Find("*", .Range("A1"), xlFormulas, xlPart, _
xlByRows, SrchDir, 0).Row
With that corrected can get rid of
Set cTL = rData(1)
Set cBR = rData(rData.Cells.Count)
Regards,
Peter T
"Peter T" <peter_t@discussions> wrote in message
news:%(E-Mail Removed)...
> Sub FitDataToWindow()
> Dim ratio As Double
> Dim rw As Long, col As Long
> Dim cTL As Range, cBR As Range, rData As Range
> Dim wn As Window
>
> LastDcell ActiveSheet, rw, col, False
> Set cTL = Cells(rw, col)
>
> LastDcell ActiveSheet, rw, col, True
> Set cBR = Cells(rw, col)
>
> Set rData = Range(cTL, cBR)
> Set cTL = rData(1)
> Set cBR = rData(rData.Cells.Count)
>
> Application.Goto cTL, True
>
> Set wn = ActiveWindow
> wn.Zoom = 100
>
> With wn.VisibleRange
>
> ratio = .Resize(, .Columns.Count - 1).Width / rData.Width
>
> If (ratio > .Resize(.Rows.Count - 1).Height / rData.Height) Then
> ratio = .Resize(.Rows.Count - 1).Height / rData.Height
> ' will zoom to height
> End If
>
> End With
>
> ' zoom can be betweeen 10-400
> If ratio > 4 Then ratio = 4
> If ratio < 0.1 Then ratio = 0.1 ' can't show all data!
>
> wn.Zoom = Int(ratio * 100)
>
> If ratio > 0.1 Then
> ' might need to reduce zoom slightly if last cell not in window
> If Intersect(wn.VisibleRange, cBR) Is Nothing Then
> wn.Zoom = wn.Zoom - 1
> End If
> End If
>
> End Sub
>
>
> Function LastDcell(ws As Worksheet, dR As Long, dc As Long, _
> bLastCell As Boolean) As Boolean
> Dim x
> Dim SrchDir As XlSearchDirection
>
> If bLastCell Then
> SrchDir = xlPrevious
> Else
> SrchDir = xlNext
> End If
>
> On Error GoTo errH
>
> With ws.Cells
> dc = .Find("*", .Range("A1"), xlFormulas, xlPart, _
> xlByColumns, SrchDir, 0).Column
> dR = .Find("*", .Range("A1"), xlFormulas, xlPart, _
> xlByColumns, SrchDir, 0).Row
> x = .Find("") 'reset Find
> End With
>
> Exit Function
> errH:
> ' typically empty sheet
> dR = 1
> dc = 1
> End Function
>
>
> Only light tested ...
>
> Regards,
> Peter T
>
> "vicky" <(E-Mail Removed)> wrote in message
> news:11527497-6c53-451a-a7da-(E-Mail Removed)...
>>i am newbie to vba programming ... i need to set the zoom according to
>> the sheets in such a way that content present in the page should
>> exactly fit in one page ... if i need to provide further details pls
>> let me know.
>
>
Similar Threads
