Ausdruck per Makro mit Kopf/Fußzeile

Question

Hallo,

ich habe eine Excel-Tabelle in einem Bereich Daten generiert werden. Diese sollen per Druck auf eine Schaltfläche ausgedruckt werden. Dazu soll in die Kopfzeile:

Links: Der Inhalt aus Zelle B24 in Arial, 12, Fett
Mitte: Ausdruck Probenahmedaten Arial, 12, Fett
Rechts: Datenbank

und in die Fußzeile:

Mitte: Seite ... von ...
Rechts: Druckdatum

Ich habe schon ein Makro mit Hilfe des Recorders und ein paar anderen Foreneinträgen erstellt, aber es treten folgende Probleme auf:

Kopfzeile Links: Steht nur Wirrwarr
Kopfzeile Mitte: die letzten beiden Buchstaben werden abgeschnitten
Fußzeile: wird gar nichts angedruckt

Hier das Makro:

ActiveWindow.SmallScroll Down:=9
Range("A20:B40").Select
ActiveSheet.PageSetup.PrintArea = "$A$20:$B$40"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$20:$B$40"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = Sheets("Tabelle1").Range("B24").Value
.CenterHeader = "&""Arial,Fett""&12Ausdruck Probenahmedaten"
.RightHeader = "Fresh-Point-Datenbank"
.LeftFooter = ""
.CenterFooter = "&P von &N"
.RightFooter = "&D"
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.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
Selection.PrintOut Copies:=1, Collate:=True
End Sub

Ich bin sicher ihr könnt mir helfen!

LG Chris

Answer 1

hi Chris :-)

wie gewünscht !

Gruss Nighty

Es sollte dafuer das BeforePrint ereigniss genutzt werden !

einzufuegen
alt+f11/projektexplorer/DeineArbeitsmappe

gegebenefalls anhand deiner makroaufzeichnung zu ergaenzen !

Private Sub Workbook_BeforePrint(Cancel As Boolean)
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Fett""&12" & Worksheets("Tabelle1").Range("B24").Value
.CenterHeader = "&""Arial,Fett""&12" & "Ausdruck Probenahmedaten"
.RightHeader = "&""Arial,Fett""&12" & "Fresh-Point-Datenbank"
.LeftFooter = "&""Arial,Fett""&12" & "erstellt von: " & Application.UserName
.CenterFooter = "&""Arial,Fett""&12" & "&P von &N"
.RightFooter = "&""Arial,Fett""&12" & "&D"
End With
End Sub

Answer 2

Hi,

Danke Nighty für die Antwort.
Leider verstehe ich nicht so wirklich, was beforeprint-ereignis bedeutet. führt er das makro dann jedes mal aus, wenn ich das dokument drucke? kann ich es dann trotzdem über eine Schaltfläche ansteuern? und kann ich dann da direkt einbauen, dass nur ein bestimmter Bereich gedruckt wird?
LG chris

Answer 3

hi Chris :-)

Du hattest schon richtig vermutet,das der Code vor jedem Druckauftrag ausgefuehrt wird !

Ich habe es nun deinen Wuenschen angepasst(Aufrufbar ueber eine Schaltflaeche),
die BereichsSelection vom ActiveSheet(Name der Tabelle spielt keine Rolle) wird gedruckt !

Gruss Nighty

Sub BereichDruckenNeuesLayout()
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Fett""&12" & ActiveSheet.Range("B24").Value
.CenterHeader = "&""Arial,Fett""&12" & "Ausdruck Probenahmedaten"
.RightHeader = "&""Arial,Fett""&12" & "Fresh-Point-Datenbank"
.LeftFooter = "&""Arial,Fett""&12" & "erstellt von: " & Application.UserName
.CenterFooter = "&""Arial,Fett""&12" & "&P von &N"
.RightFooter = "&""Arial,Fett""&12" & "&D"
End With
Selection.PrintOut Copies:=1, Collate:=True
End Sub

Answer 4

Hey Nighty,

vielen Dank. Es klappt jetzt alles!