Arbeitsmappe drucken + Fußzeile einfügen
28.07.2015 14:50:06
Jürgen
ich möchte über einen Button meine gesamte Arbeitsmappe ausdrucken und dabei noch vorher eine aktualisierte Fußzeile setzen (Druckdatum).
Aufruf über Button:
Private Sub CommandButton1_Click()
ActiveWorkbook.PrintOut Copies:=1, Collate:=True
End Sub
Coding um Fußzeile zu setzen:
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wks As Worksheet
Dim Drucken As Integer
Application.ScreenUpdating = False
For Each wks In Worksheets
' With wks.PageSetup
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = ""
' .LeftFooter = ""
' .CenterFooter = ""
' .RightFooter = ""
' .LeftHeader = ""
' .CenterHeader = ""
' .LeftFooter = ""
' .CenterFooter = ""
' .RightFooter = "&""Arial""&B&8 Gedruckt: &D"
wks.PageSetup.RightFooter = "&""Arial""&B&8 Gedruckt: &D"
' End With
Next wks
Application.ScreenUpdating = True
Sheets("Dateneingabe").Cells(1, 3).Value = 1 'Bedingte Formatierung ändern
Cancel = True
Application.EnableEvents = False
Drucken = Sheets("Dateneingabe").Cells(2, 3).Value 'Variable für alles Drucken lesen
If Drucken = 1 Then
ActiveWorkbook.PrintOut Copies:=1, Collate:=True
Else
ActiveSheet.PrintOut
End If
Application.EnableEvents = True
Sheets("Dateneingabe").Cells(1, 3).Value = 0 'Bedingte Formatierung ändern
Sheets("Dateneingabe").Cells(2, 3).Value = 0 'alles Drucken rücksetzen
End Sub
Wenn ich das ganze über die Druckfunktion aufrufe, funktioniert der Druck, der Aufruf über meinen Button bringt allerdings nichts. Ich finde aber leider den Fehler nicht.
Danke für eure Hilfe
Jürgen