Appliquer une en tête sur toutes les feuilles à l'impression
Bonjour,
J'ai utilisé l'enregistreur de macros pour paramétrer l'impression d'un fichier :
Sub Impression1()
Sheets("BureauUT1").Visible = True
Sheets("D3EUT1").Visible = True
Sheets("DDSUT1").Visible = True
Sheets("QuaiUT1").Visible = True
Sheets("BasdeQuaiUT1").Visible = True
Sheets("EspacesVertsUT1").Visible = True
Sheets(Array("BureauUT1", "D3EUT1", "DDSUT1", "QuaiUT1", "BasdeQuaiUT1", "EspacesVertsUT1")).Select
ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
"T:\PHOTO VIDEO LOGOTHEQUE - classement Référent com SL\LOGOTHEQUE\LOGOS SEVADEC\Nouvelle charte Graphique\Logos pour utilisation directe\sevadec-fondblanc.jpg"
With ActiveSheet.PageSetup.LeftHeaderPicture
.Height = 40.5
.Width = 42
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "Document Unique"
.CenterHeader = ""
.RightHeader = "SEVADEC"
.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 = 600
.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
ActiveWindow.SelectedSheets.PrintPreview
Sheets("UT1 Monod").Select
Sheets("BureauUT1").Visible = False
Sheets("D3EUT1").Visible = False
Sheets("DDSUT1").Visible = False
Sheets("QuaiUT1").Visible = False
Sheets("BasdeQuaiUT1").Visible = False
Sheets("EspacesVertsUT1").Visible = False
End Sub
J'aimerais que la macro m'affecte une en tête pour chacune des feuilles sélectionnées. C'est le redimensionnement de l'image qui me pose problème (il n'est actif que sur la première page). Ici, je pense que le "ActiveSheet" pose problème mais je ne sais pas par quoi le remplacer (j'ai essayé SelectedSheet et Selection mais ça ne fonctionne pas)...
Merci pour votre aide !
Salut,
En cherchant, j'ai trouvé ce bout de code que tu pourrais adapter à tes besoins.
Dim fl As Worksheet
For Each fl In Worksheets
If fl.Name <> "Récap" And fl.Name <> "Paramètres" Then'attention aux noms de feuilles avec accent
'ton code
End If
Next flSi ça répond à ta question, n'hésite pas à clôturer le sujet.
Bonne fin de journée
Bonjour,
Merci pour votre réponse
Bonne journée
Bonjour
On peut paramétrer l'en-tête en multi sélection... donc en une seule fois sauf le dimensionnement éventuel d'image qui lui est à faire onglet par onglet, donc il faut boucler sur chaque feuille de l'array pour la commande de redimensionnement (il suffit de donner le pourcentage de réduction)
Vous voulez dire que je dois décomposer mon code pour séparer chaque feuille et redimensionner l'image feuille par feuille ?
J'ai trouvé la solution ! J'ai redimensionné mon image depuis l'onglet Mise en page sur chaque feuille et j'ai utilisé la macro suivante :
Sub Impression1()
Sheets("BureauUT1").Visible = True
Sheets("D3EUT1").Visible = True
Sheets("DDSUT1").Visible = True
Sheets("QuaiUT1").Visible = True
Sheets("BasdeQuaiUT1").Visible = True
Sheets("EspacesVertsUT1").Visible = True
Sheets(Array("BureauUT1", "D3EUT1", "DDSUT1", "QuaiUT1", "BasdeQuaiUT1", "EspacesVertsUT1")).Select
Sheets("BureauUT1").Activate
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&G"
.CenterHeader = ""
.RightHeader = "Document Unique"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&D"
.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 = xlPrintSheetEnd
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.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 = True
ActiveWindow.SelectedSheets.PrintPreview
Sheets("UT1 Monod").Select
Sheets("BureauUT1").Visible = False
Sheets("D3EUT1").Visible = False
Sheets("DDSUT1").Visible = False
Sheets("QuaiUT1").Visible = False
Sheets("BasdeQuaiUT1").Visible = False
Sheets("EspacesVertsUT1").Visible = False
End Sub
J'espère que ce sera utile à quelqu'un