PDA

View Full Version : Solved: Print Selective Area



r_know
06-20-2012, 09:45 PM
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
06-20-2012, 10:30 PM
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
06-20-2012, 10:48 PM
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
06-20-2012, 11:01 PM
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
06-21-2012, 05:29 AM
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
06-21-2012, 11:08 AM
Not getting result in Solving Thread, pls advise anyone.

CatDaddy
06-21-2012, 11:13 AM
http://www.mrexcel.com/archive/VBA/15198b.html

Aussiebear
06-21-2012, 02:17 PM
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
06-22-2012, 10:53 AM
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