Hallo,
im Menue: Datei
klick auf: Seite einrichten
Register: Tabelle
Haken bei Schwarzweissdruckk setzen
mfg
woher

Hallo woher,
danke für die schnelle Antwort aber diese Möglichkeit funktioniert nicht der Drucker komentiert das helle Gelb als hellgrau.
Gruß Karsten

Hallo Ihr guten Geister dieses Forums, kann mir keiner einen Tipp geben wie der Druck ohne Graustufen trozdem funktioniert. Kann man vieleicht in allen Tabellenblättern alle Felder die hellgelb sind auf einmal vor dem Druck in weise Felder umwandeln und anschließend die Felder wieder hellgelb markieren. Vielen Dank im voraus.
Gruß Karsten

hast du mal probiert, den druck nur als "s/w" auszuwerfen und nicht als "graustufig"... ansonsten kann ich mir nicht vorstellen dass ein "neuer" drucker sowas nicht unterstützt...

torben

wer lesen kann, ist klar im vorteil.... meine antwort von eben wurde schon gebracht... naja...

du kannst excel auch dagen, dass definierte felder "anders gedruckt werden sollen... z. b.: drop down menus als schraffiert hinterlegete zellen... und ebenso kannst du das auch wieder abstellen über das menu "optionen"...

torben

hi all :-)

wie gewünscht :-)

gruss nighty

Sub Makro1()
Dim zaehler0 As Long
Dim zaehler1 As Integer
ReDim tab1(Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column)
For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If Cells(zaehler0, zaehler1).Interior.ColorIndex <> -4142 Then
tab1(zaehler0, zaehler1) = Cells(zaehler0, zaehler1).Interior.ColorIndex
Cells(zaehler0, zaehler1).Interior.ColorIndex = -4142
End If
Next zaehler1
Next zaehler0
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If tab1(zaehler0, zaehler1) > 0 Then Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Next zaehler1
Next zaehler0
End Sub

Hallo Nighty,
danke für Deine umfassende Lösung. Ich kenn mich zwar ein wenig aus aber eine kurze Erklärung wie es funktioniert wäre nicht schlecht, damit ich auch noch was davon lerne um es vieleicht nächstes selbst hinzubekommen.
Vielen Dank im voraus.
Gruß Karsten

hi all :-)

wie gewünscht :-)

gruss nighty

Sub Makro1()
Rem deklarierung der variablen
Dim zaehler0 As Long
Dim zaehler1 As Integer
Rem festlegung eine zwei dimensionalen feldes das von der letzten zeile wie spalte bestimmt wird
ReDim tab1(Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column)
Rem erste schleife fuer den zeilendurchlauf
For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Rem zweite schleife fuer den spaltendurchlauf
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
Rem abfrage auf gesetzte farbe (-4142=keine farbe gesetzt)
If Cells(zaehler0, zaehler1).Interior.ColorIndex <> -4142 Then
Rem farbe gefunden mit anschliessender uebergabe des farbindexes zum zweidimensionalen feld
tab1(zaehler0, zaehler1) = Cells(zaehler0, zaehler1).Interior.ColorIndex
Rem farbe der betreffenden zelle löschen
Cells(zaehler0, zaehler1).Interior.ColorIndex = -4142
Rem ende der abfrage
End If
Rem nächste spalte
Next zaehler1
Rem nächste zeile
Next zaehler0
Rem druckbefehl
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rem zurückschreiben der farbindexe vom zweidimensionalen feld zu den zellen
Rem erste schleife für den zeilen durchlauf
For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Rem zweite schleife fuer den spalten durchlauf
For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
Rem abfrage des zweidimensionalen arrays auf grösser 0 (grösser 0=farbe vorhanden) mit anschliessenden zurückschreiben des farbindexes zur zelle
If tab1(zaehler0, zaehler1) > 0 Then Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Rem nächste spalte
Next zaehler1
Rem nächste zelle
Next zaehler0
End Sub

exel ist wie ein zweidimensionales feld aufgebaut
waagerechte und senkrechte,synchron dazu das zweidimensionale feld
a1 wäre tab1(1,1) ,c3 wäre tab1(3,3) usw
daher die schleifen durchläufe der zeilen und spalten synchron zum array, wobei das feld 0 nicht genutzt wird,das man aber mit zuzählung von 1 hätte nutzen können

ein wuerfel zum beispiel wäre ein dreidimensionales feld waagerechte senkrechte tiefe

noch interessanter sind >4 dimensionale felder oder auch sich selbtständig vergrössernde felder

anzuwenden bei selbsständiger aufnahme von daten mit bezügen zu den jeweiligen indexes

Hallo Nighty,
vielen Dank für die Erläuterung. Muß ich dieses Macro in alle 9 Tabellenblätter einfügen oder nur in "Diese Arbeitsmappe". Woher weis dieses Macro welche Zellen hellgelb sind in den 9 Arbeitsblättern. Habe Macro geschrieben das diese Tabellenblätter über Button in bestimmter Reihenfolge gedruckt werden. Muß ich dieses Macro denn dort mit einbinden, und anwelcher stelle (wohl am Anfang des Druckmacros). Du siest es sind noch ein paar fragen offen.
Vielen Dank im voraus.
Gruß Karsten

hi karsten :-)

das makro ist nun auf das activesheet bezogen,daher bei jeder einzelnen tabelle aufzurufen ist

abtastung auf farbe erfolgt automatisch bzw jede farbe wird weggenommen und anschliessend wieder zurueckgesetzt

gruss nighty

Sub Makro1()
Dim zaehler0 As Long
Dim zaehler1 As Integer
ReDim tab1(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)
For zaehler0 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
If ActiveSheet.Cells(zaehler0, zaehler1).Interior.ColorIndex <> -4142 Then
tab1(zaehler0, zaehler1) = ActiveSheet.Cells(zaehler0, zaehler1).Interior.ColorIndex
ActiveSheet.Cells(zaehler0, zaehler1).Interior.ColorIndex = -4142
End If
Next zaehler1
Next zaehler0
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
For zaehler0 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
If tab1(zaehler0, zaehler1) > 0 Then ActiveSheet.Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Next zaehler1
Next zaehler0
End Sub

hi karsten :-)

hier eine geänderte version die alle vorhandenen sheets ausdruckt ohne zellen hintergrundfarbe,wie du sehen kannst ist eine weitere schleife hinzugekommen mit einem zeiger auf das letzte sheet (index ermittlung)

gruss nighty

Sub Makro1()
Dim zaehler0 As Long
Dim zaehler1 As Integer
Dim tabs As Integer
For tabs = 1 To Sheets.Count
ReDim tab1(Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Column)
For zaehler0 = 1 To Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If Sheets(tabs).Cells(zaehler0, zaehler1).Interior.ColorIndex <> -4142 Then
tab1(zaehler0, zaehler1) = Sheets(tabs).Cells(zaehler0, zaehler1).Interior.ColorIndex
Sheets(tabs).Cells(zaehler0, zaehler1).Interior.ColorIndex = -4142
End If
Next zaehler1
Next zaehler0
Sheets(tabs).PrintOut Copies:=1, Collate:=True
For zaehler0 = 1 To Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Row
For zaehler1 = 1 To Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If tab1(zaehler0, zaehler1) > 0 Then Sheets(tabs).Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Next zaehler1
Next zaehler0
Next tabs
End Sub

hi karsten :-)

noch das :-))

bei der redimensionierung erfogt ein löschen des array,du kannst aber auch eine redimensionierung mit dem parameter preserve angeben dann bleiben die daten innerhalb der redimensionierung erhalten,was aber in unseren fall nicht erforderlich ist da ja beim sheet wechsel neue daten gebraucht werden und die alten gelöscht werden muessen.

gruss nighty

Hallo Nighty,
vielen Dank für Deine Mühe. Wie kann ich denn Dein Makro in mein Druckmakro integrieren. Muß mein Druckmakro Dein Makro aufrufen oder wie kann man das lösen. Vielen Dank im voraus.
Gruß Karsten

hi karsten :-)

dieser zeile

Sheets(tabs).PrintOut Copies:=1, Collate:=True

ist duch dein makro zu ersetzen
nicht vergessen bei deinem makro sub Makroname und endsub zu entfernen

gruss nighty

Hallo Nigthy,
vielen Dank für die schnellen Antworten. Habe eben Dein Makro eingebaut. Du hast geschrieben das mit der eine Versio alle sheets ausgedruckt werden. Dies habe ich genommen habe eine Fehlermeldung bei der Zeile

ReDim tab1(Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Sheets(tabs).UsedRange.SpecialCells(xlCellTypeLastCell).Column)

Wenn ich über debuggen dann ins Makro gehe ist diese Zeile makiert. Hätte ich denn da noch irgend etwas verändern müssen das es in meine Tabelle passt.
Vielen Dank für Deine Mühe.
Gruß Karsten

Hallo kvtv,
wenn ich die Ausgangsfrage richtig interpretiere, hast Du nur die Eingabefelder gelb gemacht um bei derEingabe nicht Versehendlich in eine Falsche Zelle zu Schreiben.
Wenn ich diesen Gedanken mal weiterspinne (ich hab das für eine Kundin auch schon mal so gehandhabt), drängt sich mir die Frage auf warum Du die Zelle nach der Eingabe nicht automatisch wieder weiß darstellen läßt.
Das ist ganz einfach durch die ISTLEER(A1) Formel in der Bedingten Formatierung bewerkstelligen.

Ich will hier die Leistung von nighty nicht schmälern, er ist sicherlich um ein vielfaches besser als ich in sachen Excel, aber manchmal ist das naheliegende im Komplexen Gedankengang nicht zu Finden.

Berichtigt mich Bitte wenn ich danebenliege.

Ralf

hi karsten :-)

die mappe hat geschützte bereiche eventuell verbundene zellen :-)

nehme mit dem makrorecorder den vorgang des schützens und entschützens auf, dann hast du den code,setze schutz aufheben am anfang hin schützen dann am ende

gruss nighty