AW: Druckereinstellungen über Makro wählen
01.07.2010 20:15:35
lupo
Hallo Helmut.
Ich habe mal ein Druckermakro gebaut.
Wie Thomas schon vorschlug, habe ich das auch mit dem Makrorecoder aufgenommen und dann an meine Bedürfnisse angepasst. Unter anderem habe ich einen variablen Druckbereich abhängig vom Wert der Zelle AW 1 eingefügt.
Hier ist das gekürzte Makro:
Sub Drucker()
' Makro1 Makro
' Makro am 20.05.2008 aufgezeichnet
''Blattschutz aufheben'
ActiveSheet.Unprotect "mmd"
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintTitleColumns = "$A:$AS"
End With
For Each Zelle In Range("aw1")
If IsNumeric(Zelle.Value) Then
If Zelle.Value = 1 Then
ActiveSheet.PageSetup.PrintArea = "$A$5:$AS$93"
End If
End If
Next
For Each Zelle In Range("aw1")
If IsNumeric(Zelle.Value) Then
If Zelle.Value = 53 Then
ActiveSheet.PageSetup.PrintArea = "$A$785:$AS$798"
End If
End If
Next
'With ActiveSheet.PageSetup
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = "Ausgedruckt am" & Chr(10) & "&D" & Chr(10) & "um" & Chr(10) & "&T" & _
Chr(10) & ""
' .LeftFooter = "1.GM " & Chr(10) & "2.SZ" & Chr(10) & "3.Freigabe" & Chr(10) & "4.Runde" _
& Chr(10) & "5.BA" & Chr(10) & "6.WPvorbesp"
' .CenterFooter = _
' "7.WPbesp" & Chr(10) & "8.Do Schu" & Chr(10) & "9.PF SiGesp" & Chr(10) & "10.1:1" & _
Chr(10) & "11.HK RG" & Chr(10) & "12.SAP" & Chr(10) & "16.SV" & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
' .RightFooter = _
' "" & Chr(10) & "Bei Fragen, Anregungen und Fehlern bitte bei *****melden."
' .LeftMargin = Application.InchesToPoints(0.78740157480315)
' .RightMargin = Application.InchesToPoints(0.78740157480315)
' .TopMargin = Application.InchesToPoints(0.984251968503937)
' .BottomMargin = Application.InchesToPoints(0.984251968503937)
' .HeaderMargin = Application.InchesToPoints(0.511811023622047)
' .FooterMargin = Application.InchesToPoints(0.511811023622047)
' .PrintHeadings = False
' .PrintGridlines = False
' .PrintComments = xlPrintNoComments
' .PrintQuality = 600
' .CenterHorizontally = False
' .CenterVertically = False
' .Orientation = xlPortrait
' .Draft = False
' .PaperSize = xlPaperA4
' .FirstPageNumber = xlAutomatic
' .Order = xlDownThenOver
' .BlackAndWhite = False
' .Zoom = 51
'End With
'Blatt drucken
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Druckbereich wieder auflösen
ActiveSheet.PageSetup.PrintArea = ""
'Blattschutz wieder herstellen'
ActiveSheet.Protect Password:="mmd", DrawingObjects:=False, Contents:=True, Scenarios:= _
True
End Sub