dynamischer Druckbereich VBA

Jürgen · 2018-01-02T20:36:49+00:00

Hallo Herber Gemeinde Ich brauche eure Hilfe! Ich versuche in meiner Tabelle per Button einen dynamischen Druckbereich zu verwirklichen. Der Variable Druckbereich liegt von A107:U1000 Nun soll allerdings nur die Zeile ausgedruckt werden in der die Zell A nicht leer ist. In Zelle A ist eine Wenn Dann Formel hinterlegt welche entweder 1 oder "" ausgibt! Gedruckt soll nur die Zeile mit (jeweilige Zelle A = Wert 1). Das Makro würde so aussehen. Sub Drucken() 'makro zum Drucken inkl. Druckbereichsanpassung Dim Zeile As Long, wks As Worksheet Set wks = ActiveSheet With wks Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'Letzte Zeile mit Daten in Spalte A 'Letzte Zeile mit nummerischem Wert finden Do Until IsNumeric(.Cells(Zeile, 1).Text) Or Zeile = 1000 Zeile = Zeile - 1 Loop .PageSetup.PrintArea = .Range(.Cells(107, 1), .Cells(Zeile, 21)).Address(ReferenceStyle:= _ xlA1) .PrintOut Preview:=True End With End Sub Das Makro markiert aber immer A107:U1000 auch wenn in Zelle A "" ausgegeben wird. Nur wenn die Zelle komplett leer ist, also auch ohne Formel ist, wird der Druckbereich richtig eingegrenzt. Ich finde den Fehler nicht! p.S. dieses Makro habe ich hier in diesem Forum entdeckt. Ich habe es momentan per "Druckbutton" verknüpft, toll wäre es auch wenn das Makro Automatisch vor dem Drucken ausgeführt werden würde, aber da habe ich schon gar keine Ahnung für die Umsetzung. Es wäre toll wenn Ihr mir helfen könntet. Beste Grüße Jürgen

Hallo Jürgen,
das hier

If WorksheetFunction.CountA(.Range(.Cells(5, 2), .Cells(104, 2))) _
 WorksheetFunction.CountA(.Range(.Cells(5, 2), .Cells(104, 2))) Then
MsgBox "Wohnbereich muss belegt sein."
Exit Sub
End If

ist Quatsch. So wird zweimal im gleichen Bereich gezählt wieviele nichtleere Zellen vorhanden sind und verglichen, ob das Erbebnis unterschiedlich ist. Das kann ja nie der Fall sein, weil du zweimal den gleichen Bereich prüfst.
Ich musste noch was ändern. Ansonsten wäre es so gewesen, dass du nur die erste Zeile des jeweiligen Druckbereichs angezeigt/gedruckt bekommen hättest, sobald das Feld für den Wohnbereich leer gewesen wäre. Kannst es ja mit dem alten Code mal testen. Leg im oberen Bereich mal einen Datensatz an, ohne den entsprechenden Wohnbereich zu belegen und geh per Makro in die Druckvorschau, dann siehst du was ich meine.
Das habe ich jetzt mit der If Abfrage und der entsprechenden Belegung des Druckbereichs geregelt.
Weiter ist der Code jetzt für das jeweils aktive Tabellenblatt.

Sub Drucken() 'makro zum Drucken inkl. Druckbereichsanpassung
Dim loLetzte As Long, raDruckbereich As Range
With ActiveSheet
If WorksheetFunction.CountA(.Range(.Cells(5, 2), .Cells(104, 2))) = 0 Then
MsgBox "Es sind keine Druckdaten vorhanden."
Exit Sub
End If
loLetzte = .Columns(2).Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row
If .Cells(loLetzte, 2).Offset(-2, 0) = "" Then
Set raDruckbereich = .Range(.Cells(113, 1), .Cells(loLetzte + 3, 21))
Else
Set raDruckbereich = .Range(.Cells(113, 1), .Cells(loLetzte + 1, 21))
End If
.PageSetup.PrintArea = ""
.PageSetup.PrintArea = raDruckbereich.Address
.PrintPreview
End With
Set raDruckbereich = Nothing
End Sub

Gruß Werner

Hallo Jürgen,

Sub Drucken() 'makro zum Drucken inkl. Druckbereichsanpassung
Dim loLetzte As Long, raDruckbereich As Range
'auf das gerade aktive Blatt referenzeiren
With ActiveSheet
'zählt die nichtleeren Zellen im Bereich Cells(Zeilenwert, Spaltenwert)
'da innerhalb einer With Klammer mus vor die Range Objekte (Range, Cells) ein
'Punkt geschrieben werden. Dadurch wird auf des im With angegebene Blatt referenziert
'Hier im kontreten Fall: Wenn Anzahl nichtleerer Zellen im Bereich B5:B104 = 0
'dann Meldung ausgeben und die Sub verlassen
If WorksheetFunction.CountA(.Range(.Cells(5, 2), .Cells(104, 2))) = 0 Then
MsgBox "Es sind keine Druckdaten vorhanden."
Exit Sub
End If
'Ermitteln der letzten Zelle mit Inhalt in Spalte B (.Columns(2)) hier auch wieder
'der Punkt vor Columns weil With Klammer
'Find("*" = Joker Zellinhalt egal, sobald irgendein Inhalt in der Zelle
'LookIn:=Values = nach Zellwerten schauen, Formeln die ein "" ausgeben werden
'dadurch nicht als belegte Zelle gewertet
'SearchDirection:=xlPrevious = von unten nach oben suchen
loLetzte = .Columns(2).Find("*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row
'Prüfen ob zwei Zeilen oberhalb der ermittelten letzten belegten Zelle
'Zelle (.Offset(-2, 0) erster Wert in der Klammer = Zeilenwert, zweiter
'Wert in der Klammer = Spaltenwert, positive Werte nach unten bzw. nach rechts,
'negative Werte nach oben bzw. nach links) leer ist
If .Cells(loLetzte, 2).Offset(-2, 0) = "" Then
'wenn ja raDruckbereich auf Zelle(Zeile 113, Spalte 1) bis
'Zelle(letzte belegte Zeile + 3, Spalte 21) festlegen
Set raDruckbereich = .Range(.Cells(113, 1), .Cells(loLetzte + 3, 21))
Else
'wenn nein raDruckbereich auf Zelle(Zeile 113, Spalte 1) bis
'Zelle(Zeile(letzte belegte Zeile + 1, Spalte 21) festlegen
Set raDruckbereich = .Range(.Cells(113, 1), .Cells(loLetzte + 1, 21))
End If
'eventuell vorhandene Druckbereiche leeren
.PageSetup.PrintArea = ""
'Druckbereich festlegen durch Übergabe der Variablen
.PageSetup.PrintArea = raDruckbereich.Address
'Druckvorschau anzeigen
.PrintPreview
End With
'Rangevariable wieder leeren
Set raDruckbereich = Nothing
End Sub

Gruß Werner

Forumthread: dynamischer Druckbereich VBA

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Dynamischer Druckbereich in Excel mit VBA erstellen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)