Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
544to548
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
544to548
544to548
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Druckbereich per VBA festlegen

Druckbereich per VBA festlegen
11.01.2005 09:04:58
Stefan
Hallo!
Folgendes Beispiel: In den Spalten A bis F stehen Daten, die gedruckt werden sollen. Die letzte nichtleere Zelle in der A-Spalte zu finden soll mit VBA gelöst werden, um dann gleich automatisch den Druckbereich festzulegen und zu drucken. (Aber steht z. B. in Zelle B20 eine Formel mit dem Ergebnis "", so wird diese fälschlicher Weise in den Druckbereich mit einbezogen.
Das Problem liegt da, daß der Bereich B1:F300 mit Formeln vorbelegt ist, der Druckbereich jedoch innerhalb dieses Bereichs liegt.)
Aber wie?
Bitte um Hilfe.
Danke, Stefan

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckbereich per VBA festlegen
Wolfgang
Ein Lösungsvorschlag:

Sub DBfestlegen()
zeile = 1
Do
zeile = zeile + 1
Loop Until Cells(zeile, 1) = ""
zeile = zeile - 1
ActiveSheet.PageSetup.PrintArea = "$A$1:$A$" & zeile
End Sub

AW: Druckbereich per VBA festlegen
IngoG
Hallo Stefan
versuchs mal so:

Sub druckbereich_festlegen()
Dim maxzeile As Integer
Dim screenupdate As Boolean
If ActiveSheet.Type <> xlWorksheet Then
maxzeile = MsgBox("  Aktives Blatt ist keine Tabelle", _
vbOK, "Fehler-Duckbereich festlegen")
Else
screenupdate = Application.ScreenUpdating
Application.ScreenUpdating = False
maxzeile=[a65536].end(xlup).row
ActiveSheet.PageSetup.PrintArea = "a1:" & ActiveSheet.Cells(maxzeile, 6).Address
Application.ScreenUpdating = screenupdate
EndIf
End Sub

Gruß Ingo
PS eine Rückmeldung wäre nett...
Anzeige
AW: Druckbereich per VBA festlegen
Stefan
Danke erstmal,
leider klappt keine der beiden Varianten.
an Wolfgang: ich habe einige leere Zeilen zwischendurch. erst ab zeile 52 sind keine Lücken mehr.
an IngoG: es werden immer noch zwei seiten ausgedruckt, wenn ich weniger Werte habe und es kommt Fehler 400 (?).
AW: Druckbereich per VBA festlegen
IngoG
Hallo Stefan,
bei mir läuft das Macro.
bist Du denn sicher, dass in spalte a ansonsten keine Formeln oder leerzeichen stehen unter dem letzten Eintrag?
vielleicht lädst Du mal eine Testdatei hoch
Gruß Ingo
AW: Druckbereich per VBA festlegen
Stefan
Hallo IngoG,
entschuldige, in Spalte A sind auch Formeln, die dann aber auch "" ausgeben, also nicht mitgedruckt werden sollen. paralell geht auch noch eine bedingte Formatierung einher.
kannste bitte helfen
Gruß Stefan
Anzeige
Dann so ;-)
IngoG
Hallo Stefan,
dann sollte es so funzen:

Sub druckbereich_festlegen1()
Dim maxzeile As Integer
Dim screenupdate As Boolean
If ActiveSheet.Type <> xlWorksheet Then
maxzeile = MsgBox("  Aktives Blatt ist keine Tabelle", _
vbOK, "Fehler-Duckbereich festlegen")
Else
screenupdate = Application.ScreenUpdating
Application.ScreenUpdating = False
maxzeile = [a65536].End(xlUp).Row
While Range("a" & maxzeile) = ""
maxzeile = maxzeile - 1
Wend
ActiveSheet.PageSetup.PrintArea = "a1:" & ActiveSheet.Cells(maxzeile, 6).Address
Application.ScreenUpdating = screenupdate
End If
End Sub

Gruß Ingo
Anzeige
AW: Dann so ;-)
Stefan
Ich danke dir, klappt super!!!
um dem ganzen nun noch dir Krone aufzusetzen, noch eine Steigerung:
was muss ich machen, wenn ich in spalte a und g werte habe, die aber voneinander unabhängig sind? also eine wertereihe kann länger sein als die andere.
hast du da vielleicht auch ne idee?
oder so (erweitert) ;-)
IngoG
Hallo nochmal,
dann sollte folgende Lösung passen...
Gruß Ingo

Sub druckbereich_festlegen1()
Dim maxzeile As Integer
Dim screenupdate As Boolean
If ActiveSheet.Type <> xlWorksheet Then
maxzeile = MsgBox("  Aktives Blatt ist keine Tabelle", _
vbOK, "Fehler-Duckbereich festlegen")
Else
screenupdate = Application.ScreenUpdating
Application.ScreenUpdating = False
maxzeile = WorksheetFunction.Max([a65536].End(xlUp).Row, [g65536].End(xlUp).Row)
While (Range("a" & maxzeile) = "") And (Range("g" & maxzeile) = "")
maxzeile = maxzeile - 1
Wend
ActiveSheet.PageSetup.PrintArea = "a1:" & ActiveSheet.Cells(maxzeile, 6).Address
Application.ScreenUpdating = screenupdate
End If
End Sub

Anzeige
Großes DANKESCHÖN
Stefan
Hallo IngoG,
vielen Dank, klappt prima.
freundliche Grüße
Stefan
Danke für die Rückmeldung oT
IngoG
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige