Druckbereiche für mehrere Tabellen

Hallo zusammen,

ich habe ein Tabellenblatt indem ich 15 Tabellen erstellt habe (Einfügen --> Tabelle).
Die Tabellen beginnen ab Spalte B und jede Tabelle ist 8 Spalten lang.
In Spalte A sind 15 ToggleButton die jeweils eine Tabelle (also deren Spalten) aus- und einblendet.

Nun zu meinem Problem:
Wenn ich den Druckbereich auf eine einzige leere Tabelle setze, wächst der Druckbereich automatisch entsprechend der beschriebenen Zeilen der Tabelle mit.
Setze ich den Druckbereich auf alle Tabellen (egal ob mit STRG einzeln markiert oder alle zusammen) passiert das nicht mehr. Es wird nur die Tabellenüberschrift + die erste Zeile je Tabelle gedruckt.
Wenn ich alle Spalten ab B bis DQ markiere, werden 75 Blätter gedruckt wovon 60 leer sind.

Was kann ich machen damit alle angezeigten Tabellen entsprechend ihrer Größe gedruckt werden, ohne zig leere Blätter?

Ich hoffe es ist verständlich und freue mich auf eure Hilfe
Gruß Norman

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Onur,

Ließ bitte nochmal meine Erläuterung, diesmal aber aufmerksamer!
Jede Tabelle zieht sich über 8(!) Spalten. Es gibt insgesamt 15 Tabellen in dem Tabellenblatt.

Das Problem hat sich aber erledigt. Der Fehler war, dass ich die Tabellen schon benannt hatte, dies aber nicht berücksichtigt habe.
Für alle folgenden mit ähnlichem Problem, hier der Code welcher in das Tabellenblatt muss wo sich eure Tabellen befinden:

"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject
    Dim printArea As Range
    
    If Intersect(Target, Me.Range("Tabelle1:Tabelle15")) Is Nothing Then Exit Sub
    
    For Each tbl In Me.ListObjects
        If printArea Is Nothing Then
            Set printArea = tbl.Range
        Else
            Set printArea = Union(printArea, tbl.Range)
        End If
    Next tbl
    
    Me.PageSetup.printArea = printArea.Address
End Sub

"

"Tabelle1:Tabelle15" ersetzt ihr durch den Namen eurer Tabellen.
Solltet ihr über Namensmanager noch keine Namen vergeben haben funktioniert es mit dem Code:

"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject
    Dim printArea As Range
    
    If Intersect(Target, Me.ListObjects) Is Nothing Then Exit Sub
    
    For Each tbl In Me.ListObjects
        If printArea Is Nothing Then
            Set printArea = tbl.Range
        Else
            Set printArea = Union(printArea, tbl.Range)
        End If
    Next tbl
    
    Me.PageSetup.PrintArea = printArea.Address
End Sub

"

Dennoch vielen Dank für deine Zeit Onur.

Beliebteste Forumthreads (12 Monate)

Druckbereiche für mehrere Tabellen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Druckbereiche für mehrere Tabellen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread