Autor: Team Uwe Küstner und Beate Schmitz  --- Aus Excel VBA - Gruppe: Häufige Fragen

Druckbereich: Nur wirklich benutzten Bereich drucken

Autor: Team Uwe Küstner und Beate Schmitz - Erstellt: 2006-12-17      - Letzte Revision: 2009-06-22
Druckbereich: Nur wirklich benutzten Bereich drucken

Angenommen, Sie haben eine Tabelle auf Zuwachs vorbereitet. Und Sie wollen, dass immer automatisch nur der derzeit benutzte Bereich gedruckt wird. Dann können Sie diese Aufgabe mit diesen Codes erfüllen. Beim Druckauftrag sowie beim Aufruf der Seitenansicht wird Ihnen dann nur dieser bereits genutzte Bereich ausgegeben und zwar in jedem Blatt der Datei. Weiter unten finden Sie eine Erläuterung zum Code.

In den darüber hinaus schon präparierten Bereichen dürfen liegen:
  • Formatierungen inklusive bedingter Formatierungen (z.B. Rahmen, Hintergrundfarben, etc...)
  • Gültigkeiten inkl. Gültigkeitsdropdownzellen, insofern da noch keine Auswahl getroffen wurde
  • Überschriften, auch wenn diese über die bisher genutzten Spalten hinausgehen
  • Formeln, die leer erscheinen, solange in den Bezugszellen nichts steht (="")
  • Kommentare

Dazu müssen Sie zwei Codes in Ihre Datei so einzufügen:

Fügen Sie diese benutzerdefinierte Funktion in ein Allgemeines Modul ein:

Public Function LetzteZelle(oWs As Worksheet, _
        Optional AnzahlUeberschriften As Long, _
        Optional Bereich As Range) As Range
  'Uwe Küstner 20090620
  Dim iCol As Integer
  Dim lRow As Long, lRowA As Long, lRowE As Long, lRowMax As Long
  Dim rngC As Range, rngM As Range
  iCol = 1
  If Bereich Is Nothing Then Set Bereich = oWs.UsedRange
  lRowA = Bereich.Row + AnzahlUeberschriften
  lRowE = Bereich.Row + Bereich.Rows.Count - 1
  For Each rngC In Bereich.Columns
    For lRow = lRowE To lRowA Step -1
      If Len(oWs.Cells(lRow, rngC.Column).MergeArea(1).Text) Then
        iCol = rngC.Column
        lRowMax = Application.WorksheetFunction.Max(1, lRow, lRowMax)
        Exit For 'lRow
      End If
    Next lRow
  Next rngC
  If lRowMax = 0 Then Exit Function
  Set rngM = Bereich.EntireColumn
  'jetzt werden eventuell vorhandene Verbundene Zellen,
  'die sich nach unten über den soeben ermittelten
  'Bereich erstrecken, in diesen mit eingebunden:
  Do
    lRowE = lRowMax
    Set Bereich = Application.Intersect(rngM, oWs.Rows(lRowMax))
    For Each rngC In Bereich
      With rngC
        If .MergeCells Then
          lRowMax = Application.WorksheetFunction.Max _
            (1, .MergeArea.Row + .MergeArea.Rows.Count - 1, lRowMax)
        End If
      End With
    Next rngC
  Loop While lRowMax > lRowE
  Set LetzteZelle = oWs.Cells(lRowMax, iCol)
End Function

Fügen Sie diese Ereignisprozedur in das schon bestehende Modul DieseArbeitsmappe ein:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim WsA As Worksheet
  Dim rngLC As Range
  Set WsA = ActiveSheet
  Set rngLC = LetzteZelle(WsA, 1)
  If Not rngLC Is Nothing Then
    Application.DisplayAlerts = False
    WsA.PageSetup.PrintArea = WsA.Range("A1", rngLC).Address
    Application.DisplayAlerts = True
  Else
    WsA.PageSetup.PrintArea = ""
    Cancel = True
  End If
End Sub


Hier eine Erläuterung zum Code:

Es klinkt sich automatisch bei jedem Auslösen des Druckvorgangs oder der Druckvorschau die Ereignisprozedur 'Workbook_BeforePrint' ein.

Die Zeile: WsA.PageSetup.PrintArea = WsA.Range("A1", LetzteZelle(WsA, 1)).Address

ermittelt mit Hilfe der Funktion LetzteZelle die letzte "ausdruckwürdige" Zelle und stellt den Druckbereich entsprechend ein.

Die Funktion LetzteZelle wertet 3 Parameter aus:
der 1. ist das Blatt als Objekt,
der 2. ist die Anzahl der Überschriften als Zahl(Default: 0=keine Überschriften) und
der 3. ist der Bereich (Default: Gesamter benutzter Bereich), der ausgewertet werden soll.
Die Paramter 2 und 3 sind optional, können also entfallen.
Im Beispiel steht eine 1 für eine Überschriftenzeile.


Tipp:
Während Sie Workbook_BeforePrint Makros einbauen und diese testen wollen, benutzen Sie nur die Druckvorschau. Das spart Papier und Sie sehen das Ergebnis wie im Ausdruck.




Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben
ToDo
Google Werbung