Not Sure If This Print Can Be Achieved?

BluesBros

New Member
Joined
Jan 16, 2005
Messages
42
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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

tmischler

Well-known Member
Joined
Jun 17, 2004
Messages
669
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

Active Member
Joined
Apr 12, 2004
Messages
348
How about
Code:
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
 

Forum statistics

Threads
1,147,846
Messages
5,743,518
Members
423,801
Latest member
paulj4177

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top