fr832
XLDnaute Occasionnel
Bonsoir à tous j'ai eu ce code pour une impression grâce à l'enregistreur VBA, le problème c'est que le code est long à ce réaliser y a t'il moyen d'alleger ce code ?
Par avance merci à tous
Par avance merci à tous
Code:
Sub impressionordinaires()
Range("A2:F48").Select
ActiveSheet.PageSetup.PrintArea = "$A$2:$F$48"
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$4"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$2:$F$48"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""Times New Roman,Italique""&9Imprimé le &D"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 71
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub