Macro impressions successives
Bonjour, je souhaite lancer 2 impressions successives avec des paramètres différents. J'ai effectuée une macro classique que j'ai intégrée dans le code d'un bouton de commande. Mais seule la première impression fonctionne, pour la deuxième j'ai un "bogue". C'est cette commande qui a l'air de poser problème : "Application.PrintCommunication = True". Je vous joins le code. Merci pour votre aide. Stéphane
Private Sub CommandButton1_Click()
'
' PrintAffichage1 Macro
'
'
ActiveSheet.Unprotect
Range("A4").Select
With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields( _
"Emplacement")
.PivotItems("").Visible = False
End With
ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("Emplacement") _
.LayoutPageBreak = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("Emplacement") _
.LayoutPageBreak = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = -2
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = True
.FitToPagesWide = 1
.FitToPagesTall = False
.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 = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.PrintQuality = -2
.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
Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("Emplacement") _
.LayoutPageBreak = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Range("A1").Select
End SubBonjour, je relance cette question. Merci.
legreffier
Invité
Bonjour Legreffier
Vous avez bien fait
de ce que je vois et que je comprends, le code peut être réduit à ceci
Private Sub CommandButton1_Click()
Dim Ind As Integer
'
' Avec l'objet conteneur parent
With ActiveSheet
.Unprotect
' Mise en page
With .PageSetup
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
.LeftMargin = Application.CentimetersToPoints(0.8)
.RightMargin = Application.CentimetersToPoints(0.8)
.TopMargin = Application.CentimetersToPoints(0.8)
.BottomMargin = Application.CentimetersToPoints(0.8)
.Orientation = xlLandscape
.Zoom = True
.FitToPagesWide = 1
.FitToPagesTall = False
End With
' Définir le pivot table
With .PivotTables("Tableau croisé dynamique7")
.PivotFields("Emplacement").PivotItems("").Visible = False
.PivotFields("Emplacement").LayoutPageBreak = True
End With
' Imprimer 2 fois
For Ind = 1 To 2
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next Ind
' supprimer saut de page du pivot !?
With .PivotTables("Tableau croisé dynamique7")
.PivotFields("Emplacement").LayoutPageBreak = False
End With
' Reprotéger la feuille
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With
End SubA tester
A+
Bonjour BrunoM45, c'est nickel ! Merci à vous et bon we :-)