bei Druck nur s/w
07.01.2018 13:33:02
Peer
Ich komme gerade nicht weiter.
Ich möchte, dass der Ausdruck, der im Sheet farblich ist, beim Ausdruck s/w bzw grau ausgedruckt wird.
Dabei habe ich folgenden Code in einem Modul eingefügt und einer Formularschaltfläche "Drucken" als Makro zugewiesen.
Nur druckt er nicht in grau/sw, sondern weiterhin in Farbe.
Ich habe hier erstmal nur die Seitenvorschau "freigeschalten".
Sub druck_grau_Click()
Dim arrWerte() ' Variable für Array
Dim raZelle As Range ' Variable für die Zelle als Range
Dim loZaehler As Long ' Schleifenzähler
Dim loZaehler2 As Long ' Schleifenzähler
Dim rngDruckbereich As Range ' Druckbereich
ActiveSheet.PageSetup.PrintArea = "$B$1:$O$50"
'Druckbereich festlegen
Set rngDruckbereich = Range("B1,O50")
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' Blattschutz aufheben
ActiveSheet.Unprotect Password:=""
' Ausführung in Tabelle1
With Worksheets("Januar")
' Schleife über jede Zelle des benutzten Bereichs
For Each raZelle In Worksheets("Januar").UsedRange
' Zelle ist mit einer Füllfarbe formatiert
If raZelle.Interior.Color xlNone Then
' Array dynamisch erweitern
ReDim Preserve arrWerte(0 To 2, 0 To loZaehler)
' Einlesen der Zelladresse in das Array
arrWerte(0, loZaehler) = raZelle.Address
' Einlesen der Füllfarbe in das der Zelle in das Array
arrWerte(1, loZaehler) = raZelle.Interior.Color
' Füllfarbe der Zelle zurücksetzen
raZelle.Interior.Color = xlNone
' Schleifenzähler um 1 erhöhen
loZaehler = loZaehler + 1
End If
Next raZelle
' Tabelle drucken
' .PrintOut
' Seitenvorschau öffnen
.PrintPreview
' Drucker Auswahl Dialog öffnen
' .Application.Dialogs(xlDialogPrint).Show
' Schleife über alle Elemente des Arrays
For loZaehler2 = 0 To loZaehler - 1
' Zurückübertragen der ausgelesenen Füllfarben
.Range(arrWerte(0, loZaehler2)).Interior.Color = arrWerte(1, loZaehler2)
Next loZaehler2
End With
' Blattschutz aktivieren
ActiveSheet.Protect Password:=""
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub
Wo ist hier der Fehler.Übersehe ich etwas?
Anbei da File als zip (weil sonst zu gross)
https://www.herber.de/bbs/user/118746.zip
Vielen Dank für die Hilfe.
LG
Peer