Not Sure If This Print Can Be Achieved?

[BluesBros]

I've recorded a Macro as shown below. Currently columns G:I are re-sized and then printed in lanscape on one page.

However this makes some of the pages look silly as only a small amount of data may be printed.

Is it possible to set the macro to check and see if the column widths combined after re-sizing exceed 90 (not sure what its measured in). If they exceed 90 then print as landscape otherwise print as portrait.

Not sure if I've explained that very well?

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 19/01/2005 by Nick
'

'
Columns("G:I").Select
Selection.Columns.AutoFit
Range("F2:I58").Select
ActiveWindow.LargeScroll ToRight:=2
ActiveSheet.PageSetup.PrintArea = "$F$2:$I$58"
Range("G4").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$F$2:$I$58"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Columns("G:I").Select
Selection.ColumnWidth = 30
ActiveWindow.ScrollColumn = 1
Range("E4").Select
End Sub

 

[tmischler]

There's probably a better way, but this should work

Sub Macro1()

Dim i As Double
Columns("G:I").EntireColumn.AutoFit
i = Columns("G:G").ColumnWidth + Columns("H:H").ColumnWidth + Columns("H:H").ColumnWidth

If i > 90 Then

With ActiveSheet.PageSetup
.PrintArea = "$F$2:$I$58"
.PrintTitleRows = "$1:$1"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Else

With ActiveSheet.PageSetup
.PrintArea = "$F$2:$I$58"
.PrintTitleRows = "$1:$1"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

End If

End Sub

 

[yankee428]

How about

a = Columns("G").ColumnWidth + Columns("I").ColumnWidth
If a > 90 Then
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
    End With
Else
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
    End With
End If