Supportnet / Forum / Tabellenkalkulation

Hallo, ich brauch mal wieder Eure Hilfe!!! Ich habe mehrere Kleine Tabellen in ein Tabellenblatt erstellt um dort Messergebnisse einzutragen. Jetzt hab ich aus optischen Gründen für den Benutzer die Zeilen grau ausgefüllt die ohne jeglichen Inhalt und die nicht zu den Tabellen gehört. Es ist nur gemacht das die Tabelle besser hervorgehebt wird. Nur das Problem ist jetzt dabei, wenn ich drucken möchte wird der graue Hintergrund auch mitgedruckt. Jetzt meine Frage, kann man irgendwie die Hintergrundfare ändern (nur aus optischen Gründen), aber es wird trotzdem der Hintergrund nicht mit gedrucket und bleibt weiß??? Vielen Dank für Eure Mühe!! Gruß Elhamplo

Wenn du auf Farben im Ausdruck verzichten kannt, aktiviere die Option "Schwarzweißdruck" in "Datei" - "Seite einrichten..." Registerkarte "Tabelle".

Gruß Flupo

hi all :)

sollten dennoch andere farben mitgedruckt werden,dann so

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,

@ Flupo

Danke für den Tipp. Doch die Überschriften solten doch farbig ausgedruckt werden.

Danke!!!

@ nighty

Danke für den Code. Das Problem dabei ist, das alle Füllfarben zurückgesetzt werden auch die in den Überschriften.

Kann man nicht sagen alle Zellen mit der Farbe Grau (helstes Grau, als Füllfarbe) werden vor dem Drucken weiß und anschließend wieder grau?? So im Prinziep wie im Code??

Auchwollte ich dieses dann auch Anwenden in Dateien wo ich verschiedene Tabellen untereinader habe und Leerzeilen dazwischen.

Ich danke für die Mühe die Du Dir (Ihr) machst!!!

Gruß

Elhamplo

hi all :)

dann so,der hellste grauton farbindex 15 wird beruecksichtigt

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 = 15 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) = 15 Then Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Next zaehler1
Next zaehler0
End Sub

hi all :)

bzw mit bereichsangabenerklärung

gruss nighty

Sub Makro1()
Dim zaehler0 As Long
Dim zaehler1 As Integer

zellenanzahl des unten angegebenen bereiches=Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column

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

1 = Anfang senkrechte

Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row = Ende senkrechte

For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

1 = Anfang waagerechte

Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column =Ende waagerechte


For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If Cells(zaehler0, zaehler1).Interior.ColorIndex = 15 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

wie oben beschrieben

For zaehler0 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row

wie oben beschrieben

For zaehler1 = 1 To Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
If tab1(zaehler0, zaehler1) = 15 Then Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0, zaehler1)
Next zaehler1
Next zaehler0
End Sub

Hallo nighty,

der erste Code fust Super, danke!!!!!

Den zweiten versteh ich noch nicht so ganz, klappt irgendwie auch nicht, bekomm immer Fehlermeldungen und die Zeilen sind rot Makiert. Keine Ahnung wo ich den Fehler gemacht habe.

Danke!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Gruß

Elhamplo

hi Elhamplo

wenn es dich interessieren sollte,hier hab mir mehr muehe gegeben,rem zeilen sind kommentare

gruss nighty

Sub Makro1()
Rem deklarierung
Dim zaehler0 As Long
Dim zaehler1 As Integer
Dim SenkrechteAnfang As Long
Dim SenkrechteEnde As Long
Dim WaagerechteAnfang As Integer
Dim WaagerechteEnde As Integer
Rem angenommen es sind 20 felder,daher 4*5=20
Rem in diesem beispiel E4 als linke obere ecke bis I9 als rechte untere ecke als bereich definiert
Senkrechte = 4
Waagerechte = 5
Rem dimensionierung eines 2 dimensionalen feldes,wobei feld index 0 nicht genutzt wird
ReDim tab1(Senkrechte, Waagerechte)
Rem zuweisung des bereiches bzw 4*5 felder bzw zellen
SenkrechteAnfang = 4
SenkrechteEnde = 7
WaagerechteAnfang = 5
WaagerechteEnde = 9
For zaehler0 = SenkrechteAnfang To SenkrechteEnde
For zaehler1 = WaagerechteAnfang To WaagerechteEnde
Rem abfrage auf hintergrundfarbindex 15 bzw statt =15 <>-4142 auf beliebige farben
If Cells(zaehler0, zaehler1).Interior.ColorIndex = 15 Then
Rem bei der zuweisung des array ist
Rem -3 bzw -4 bei dem array um auf 1 als startwert zu kommen
tab1(zaehler0 - 3, zaehler1 - 4) = Cells(zaehler0, zaehler1).Interior.ColorIndex
Cells(zaehler0, zaehler1).Interior.ColorIndex = -4142
End If
Next zaehler1
Next zaehler0
Rem druckbefehl
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rem weitere schleife zum zuruecksetzen des farbhintergrundes der im zwei dimensionalen array gespeicherten werte
For zaehler0 = SenkrechteAnfang To SenkrechteEnde
For zaehler1 = WaagerechteAnfang To WaagerechteEnde
Rem -3 bzw -4 bei dem array um auf 1 als startwert zu kommen
If tab1(zaehler0 - 3, zaehler1 - 4) > 0 Then Cells(zaehler0, zaehler1).Interior.ColorIndex = tab1(zaehler0 - 3, zaehler1 - 4)
Next zaehler1
Next zaehler0
End Sub

Hallo,

sorry, kam jetzt erst dazu alles auszuprobieren. Super, danke für die gute Beschreibung des Codes. Der funst Super!!!

Vielen, vielen Dank für die Mühe die Du Dir gemacht hast.

Gruß

Elhamplo

• Pfalzmarkierung mitdrucken?
• exel tabellen drucken
• Hintergrundfarbe in OOWriter
• Hintergrundfarbe verknüpfen