Djblois
05-22-2007, 06:56 AM
This community has helped me so much, I decided to share a little macro that I just developed that is a god send:
Sub PagSetAdjustPageWidth()
Dim dblPagWidth As Double
'Determine the page width that would make the report more than one page wide for each _
percentage, orientation, and papersize
dblPagWidth = 0
For i = 1 To FinalColumn
dblPagWidth = dblPagWidth + Cells(1, i).ColumnWidth
Next i
If dblPagWidth < 100 Then
With ActiveSheet.PageSetup
.Zoom = 100
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 110 Then
With ActiveSheet.PageSetup
.Zoom = 90
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 125 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 145 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 150 Then
With ActiveSheet.PageSetup
.Zoom = 90
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 170 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 195 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 195 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 215 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
ElseIf dblPagWidth < 250 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
ElseIf dblPagWidth < 290 Then
With ActiveSheet.PageSetup
.Zoom = 60
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
Else
With ActiveSheet.PageSetup
.Zoom = 50
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report is too large. Consider breaking it up into a few reports."
End If
End Sub
Function FinalColumn()
Dim FinalColumnB As Long
FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
FinalColumnB = Cells(2, Columns.Count).End(xlToLeft).Column
If FinalColumnB > FinalColumn Then FinalColumn = FinalColumnB
End Function
Some people may ask why don't I just use adjust to page width, well it works like !@#$ lol. A lot of times it makes the font too small, even with a lot of extra room on the sides of the page. Also, zoom is only useful if the spreadsheet is always the same size. This way it will determine the size you need, the orientation you need, and the paper size.
Daniel
Sub PagSetAdjustPageWidth()
Dim dblPagWidth As Double
'Determine the page width that would make the report more than one page wide for each _
percentage, orientation, and papersize
dblPagWidth = 0
For i = 1 To FinalColumn
dblPagWidth = dblPagWidth + Cells(1, i).ColumnWidth
Next i
If dblPagWidth < 100 Then
With ActiveSheet.PageSetup
.Zoom = 100
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 110 Then
With ActiveSheet.PageSetup
.Zoom = 90
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 125 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 145 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 150 Then
With ActiveSheet.PageSetup
.Zoom = 90
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 170 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 195 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 195 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlLandscape
.PaperSize = xlPaperLetter
End With
ElseIf dblPagWidth < 215 Then
With ActiveSheet.PageSetup
.Zoom = 80
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
ElseIf dblPagWidth < 250 Then
With ActiveSheet.PageSetup
.Zoom = 70
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
ElseIf dblPagWidth < 290 Then
With ActiveSheet.PageSetup
.Zoom = 60
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report will print on Legal Paper"
Else
With ActiveSheet.PageSetup
.Zoom = 50
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
End With
MsgBox "The Report is too large. Consider breaking it up into a few reports."
End If
End Sub
Function FinalColumn()
Dim FinalColumnB As Long
FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
FinalColumnB = Cells(2, Columns.Count).End(xlToLeft).Column
If FinalColumnB > FinalColumn Then FinalColumn = FinalColumnB
End Function
Some people may ask why don't I just use adjust to page width, well it works like !@#$ lol. A lot of times it makes the font too small, even with a lot of extra room on the sides of the page. Also, zoom is only useful if the spreadsheet is always the same size. This way it will determine the size you need, the orientation you need, and the paper size.
Daniel