Solved: Print Selective Area

[r_know]

Dear All,

I am looking forwards to make a print by using VBA Code for selective area.

I have Sheet2.Range(AL2:AV34) to be selected and Print.

Print Properties,
A. Selection Print for given area.
B. Selection Area Fits in to the A4 paper as maximum as. (As Tall and Wide)
C. Print Orientation, Landscape

Regards,

Rahul

[GTO]

Hi Rahul,

Try recording a macro, selecting the options you want for printing. I believe it would be fairly easy to modify from the resultant macro.

[Aussiebear]

You could start with the following as an initial point of entry to the macro

Sub Print_Area()

Range("AL2:AV34").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 200
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub

[r_know]

Hi GTO,

I did the same in Initial Step where I received the error in Fittopagewide must be between 10 to 400. Therefore, I posted the thread.

Dear Aussiebear,
I am getting debug, .PrintQuality = 200 and if I choose RUN to cursor. Then at end shows, PrintPreview.
I need Print, in One Page.

Thanks

Rahul

[GTO]

Clear the print area, then carefully step through the options you wwant while recording. Show us the result. BTW, PrintQuality only works on certain printers I believe.

[r_know]

Not getting result in Solving Thread, pls advise anyone.

[CatDaddy]

http://www.mrexcel.com/archive/VBA/15198b.html

[Aussiebear]

I am getting debug, .PrintQuality = 200 and if I choose RUN to cursor. Then at end shows, PrintPreview.
I need Print, in One Page.

What steps have you taken?

I recorded that section of code and followed the requests that you asked for, other than the actual print. GTO & I have given you a very good start to the macro. Have you tried recording a macro yourself?

[r_know]

Finally Work....

Thanks for all your suggestions........:beerchug:

Sub PrintTS()
ActiveSheet.Range("AL2:AV34").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.PrintOut Copies:=1, Collate:=True
ActiveSheet.Range("AL2").Select
End Sub