AW: ausgewählte tabellenblätter drucken
24.02.2007 15:34:00
fcs
Hallo Lorenz,
eigentlich wollte ich eine kleine Beispieldatei hochladen, funktioniert im Moment leider nicht :(.
Füge in deiner Datei ein zusätzliches Tabellenblatt ein. Nach folgendem Schema trägst du die Bereichsnamen in der Spalte A ein und die Namen der zugehörigen Tabellen in den Spalten rechts daneben.
Im VBA-Editor fügst unter der Tabelle eine der beiden folgenden Prozduren ein, je nachdem ob die Blätter eines Bereichs als gruppierte Blätter oder einzeln gedruckt werden sollen.
Gruß
Franz
Tabellenblattname: Drucken
A B C D
1
2
3 Zum Drucken der Tabellen eines Bereichs in Spalte A auf den Namen des Bereichs klicken
4 Der Ausdruck erfolgt mit Gruppierung der Registerblätter
5
6 Bereich Namen der Tabellen, die bei Anklicken des Bereichs gedruckt werden
7 Sport Fussball Handball Golf
8 Auto Opel Mercedes
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Variante 1:
'Die einem Bereich zugeordneten Tabellenblätter werden gruppiert und gedruckt
Dim TabNames(), text As String
If Target.Column = 1 And Target.Row > 6 And Target.Cells.Count = 1 _
And Not IsEmpty(Target) Then
'Tabellennamen einlesen
SpalteL = Me.Cells(Target.Row, Me.Columns.Count).End(xlToLeft).Column
ReDim TabNames(1 To SpalteL - 1)
text = "Folgende Tabellen drucken ? "
For Spalte = 2 To SpalteL
TabNames(Spalte - 1) = Me.Cells(Target.Row, Spalte)
text = text & vbLf & Me.Cells(Target.Row, Spalte)
Next
If MsgBox(text, vbYesNo, "Tabellen Bereiche drucken") = vbYes Then
Sheets(TabNames).PrintOut
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Variante 2:
'Die Blätter eines Bereiches werden einzeln in der Reihenfolge der Zelleinträge gedruckt.
Dim text As String
If Target.Column = 1 And Target.Row > 6 And Target.Cells.Count = 1 _
And Not IsEmpty(Target) Then
'Tabellennamen einlesen
SpalteL = Me.Cells(Target.Row, Me.Columns.Count).End(xlToLeft).Column
text = "Folgende Tabellen drucken ? "
For Spalte = 2 To SpalteL
text = text & vbLf & Me.Cells(Target.Row, Spalte)
Next
If MsgBox(text, vbYesNo, "Tabellen Bereiche drucken") = vbYes Then
For Spalte = 2 To SpalteL
Sheets(Me.Cells(Target.Row, Spalte).Value).PrintOut
Next
End If
End If
End Sub