Comment améliorer ce code

[jacky49]

Bonjour le forum,

j'ai ce code ci-dessous que j'ai fait avec l'enregistreur de macro et je voudrais l'épurer un peu car il est un peu long
merci d'avance
Jacky

Sub MiseEnPage()
'
' MiseEnPage Macro
'

'
    Range("A1:K29").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$29"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$29"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.15748031496063)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .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 = -3
        .CenterHorizontally = True
        .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
    Application.PrintCommunication = True
    Range("J10").Select
End Sub

 

[Gorfael]

Re : Comment améliorer ce code

Salut le forum
Pour épurer une macro, il faut savoir ce qu'elle est censée faire !
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
Tu peux supprimer les ligne qu'elle ne doit pas modifier. Par exemple dans ce début de modification de la mise en page, si tu ne modifies aucun en-tête de page, tu peux supprimer les 3 ".xxxxHeader"
Si, par exemple tu veux supprimer le titre en haut à gauche, ta macro commencera par :
With ActiveSheet.PageSetup
.LeftHeader = ""
.LeftFooter = ""
Idem pour le reste
A+

 

[Robert]

Re : Comment améliorer ce code

Bonjour Jacky, Gorfael, bonjour le forum,

Tout à fait d'accord avec Gorfael. Ne garde, des paramètres, que ceux que tu as modifiés. Tu peux effacer le reste et les doublons...
Peut-être comme ça :

Sub MiseEnPage()
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$29"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .CenterHorizontally = True
    .CenterVertically = False
    .Orientation = xlLandscape
    .PaperSize = xlPaperA4
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
End With
Application.PrintCommunication = True
Range("J10").Select
End Sub

 

[jacky49]

Re : Comment améliorer ce code

Bonsoir le forum, Gorfael, Robert,

merci cela fonctionne mais j'ai un autre souci, mon code qui me sert à mettre mon tableau qui va de A1 a K29 sur une seule page et centré horizontalement, je voudrais qu'il fonctionne sur toute les feuilles mais la ne fonctionne sur une seule
merci
jacky

 

[Robert]

Re : Comment améliorer ce code

Bonjour le fil, bonjour le forum,

le code ci-dessous agit sur TOUS les onglets du classeur :

Sub MiseEnPage()
Dim o As Object 'déclare la variable o (Onglet)

For Each o In Sheets 'boucle sur tous les onglets du classeur
    o.Activate 'active l'onglet
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$29"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Application.PrintCommunication = True
    Range("J10").Select
Next o 'prochain onglet de la boucle
End Sub

 

[jacky49]

Re : Comment améliorer ce code

Bonjour le forum, Robert,

merci cela fonctionne impeccable
jacky