Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 15:16:20
VBA Suchen, Kopieren, Einfügen
18.04.2024 15:16:07
Verschieben von Daten um bestimmte Zeilen nach unten
18.04.2024 15:13:44
Text ans untere Ende der Seite verschieben
18.04.2024 15:00:48
Datum als Datum sehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
840to844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
840to844
840to844
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Druckbereich

Druckbereich
03.02.2007 00:41:00
Gordon
Moin,
ich bräuchte mal Hilfe beim Druckbereich festlegen. Und zwar in zwei Fällen.
Fall 1:
Ich habe eine Tabelle die sich in der länge bzw. Zeilen Anzahl immer wieder mal ändern kann. Und daher hätte ich es auch gerne, dass sie der festgelegte Druckbereich mitändert. Die Spalten sind von A bis G. Der eigentliche Tabelleninhalt beginnt ab Reihe 3. Reihe 1 und 2 sollen aber auch noch mit rauf. Und der Druckbereich soll nun eine Reihe nach der letzten Tabellereihe enden.
Fall2:
Etwas komplizierter. Ich habe einen Tabellenblatt wo die Spalten A bis Q im Druckbereich liegen sollen. Der Druckbereich soll auch ab der ersten Reihe anfangen. Der Druckbereich soll sich aber nach bestimmten Zeilen richten. Und zwar fängt es bei Zelle A8 an und geht dann in 22er-Schritten immer weiter. Die Zelle wo also Infos drin stehen sind zB: a8, a30, a52, a74, a96, usw....
Sollte irgendwann in diesen 22er-Schritten 'ne Zelle ohne Wert auftauchen, dann soll der Druckbereicht acht Reichen über dieser leeren Zelle enden. Also ist Zelle "A118" leer, soll der Druckbereich bis einschließlich Zeile 110 gehen, als A1:Q110.
Kann mir da jemand weiterhelfen? Optimal wäre es, wenn das alles automatisch passieren würde, also das ich keine Button drücken muss.
Gruß
Gordon

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckbereich
03.02.2007 09:08:57
Beate
Hallo Gordon,
zu deiner ersten Frage: Den Code ins Codefenster "dieseArbeitsmappe" einfügen und den Tabellennamen im Code anpassen:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name = "Tabelle1" Then
    With Worksheets("Tabelle1")
        .PageSetup.PrintArea = "$A$1:$G$" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    End With
End If
End Sub
Gruß,
Beate
Anzeige
AW: Druckbereich
03.02.2007 09:57:14
fcs
Hallo Gordon,
nachfolgenden Code im VBA-Editor unter DieseArbeitsmappe einfügen. Für Tabelle1 kannst du ggf. auch den etwas eleganteren Code von Beate verwenden.
Gruss
Franz

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Bereich As Range, wks As Worksheet, Zeile As Long
'Druckbereich von Tabellen vor dem Drucken/der Seitenvorschau anpassen
Set wks = ActiveSheet
Select Case wks.Name
Case "Tabelle1"
With wks
For Spalte = 1 To 7 '(A bis G)
Zeile = Application.WorksheetFunction.Max(Zeile, .Cells(.Rows.Count, Spalte).End(xlUp).Row)
Next Spalte
Zeile = Zeile + 1
'       .PageSetup.PrintTitleRows = "1:2"
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 7)).Address
End With
Case "Tabelle2"
With wks
Zeile = 8
Do Until IsEmpty(.Cells(Zeile, 1))
Zeile = Zeile + 22
Loop
Zeile = Zeile - 8
'        .PageSetup.PrintTitleRows = "1:2"
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 7)).Address
End With
Case Else
'do nothing
End Select
End Sub

Anzeige
AW: Druckbereich
03.02.2007 14:37:56
Gordon
Super,
hat gleich geklappt. *freu*
Aber eine Frage habe ich noch zum 2.Fall. Und zwar habe ich nun ein zweites Tabellenblatt, was ich mit dem Druckbereich genauso behandeln will. Wie muss ich also den Code im 2.Fall verändern, dass es er für zwei bestimmte Tabellenblätter greift.
Gordon
AW: Druckbereich
03.02.2007 14:45:03
fcs
Hallo Gordon,
du muss in der Case-Anweisung nur den 2. Tabellennamen ergänzen
Beispiel 

Case "Tabelle2", "Tabelle3"

Gruss
Franz
AW: Druckbereich
03.02.2007 14:55:18
Gordon
Genau das dachte ich auch.
Aber dann schmeißt er mir immer folgende Fehlermeldung raus:
"Laufzeitfehler '1004':
Anwendungs- oder objektdefinierter Fehler"
Beim debuggen zeigt wird folgende Zeile makiert:
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 17)).Address
Anzeige
AW: Druckbereich
03.02.2007 18:01:08
Daniel
Hallo
bei mir funktioniert die Zeile, allerdings einzeln in einem Testmakro
lass doch in dieser Zeile einfach mal die Punkte weg, schließlich brauchst du ja nur die Addresse, und die ist vom Sheet unabhängig.
oder du gerenerierst die Printaerea gleich als String, dann sollte das Problem gar nicht erst auftauchen.
.PageSetup.PrintArea = "$A$1:$Q$" & Zeile
Gruß, Daniel
AW: Druckbereich
03.02.2007 18:54:56
fcs
Hallo Gordon,
der Fehler tritt auf wenn Zelle A8 leer ist.
Also ggf. ab Zelle A30 in 22 Schritten prüfen ob Zelle leer ist
Gruss
Franz

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Bereich As Range, wks As Worksheet, Zeile As Long
'Druckbereich von Tabellen vor dem Drucken/der Seitenvorschau anpassen
Set wks = ActiveSheet
Select Case wks.Name
Case "Tabelle1"
With wks
For Spalte = 1 To 7 '(A bis G)
Zeile = Application.WorksheetFunction.Max(Zeile, .Cells(.Rows.Count, Spalte).End(xlUp).Row)
Next Spalte
Zeile = Zeile + 1
'       .PageSetup.PrintTitleRows = "1:2"
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 7)).Address
End With
Case "Tabelle2", "Tabelle3"
With wks
Zeile = 30
Do Until IsEmpty(.Cells(Zeile, 1))
Zeile = Zeile + 22
Loop
Zeile = Zeile - 8
'        .PageSetup.PrintTitleRows = "1:2"
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 7)).Address
End With
Case Else
'do nothing
End Select
End Sub

Anzeige
AW: Druckbereich
04.02.2007 00:01:57
Gordon
Super,
nun geht's. Danke! :)

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige