Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
adjust zoom according to sheet
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
adjust zoom according to sheet
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" wrote in message ... 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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
adjust zoom according to sheet
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 ... 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" wrote in message ... 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
adjust zoom according to sheet
On Nov 3, 5:36*pm, "Peter T" <peter_t@discussions wrote:
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 ... 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" wrote in message .... 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.- Hide quoted text - - Show quoted text - thanks a lot peter . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Please help! Print Preview Zoom is Grayed Out...Doesn't zoom. | Excel Discussion (Misc queries) | |||
zoom in &zoom out in VBA User Form | Excel Programming | |||
Can a macro be written that when you open a workbook the zoom will be set for each sheet? | Excel Programming | |||
Setting Sheet Display Zoom Magnification in VBA | Excel Programming | |||
Auto Adjust Spread Sheet so it will print on 1 page/legal/landscap | Excel Worksheet Functions |