Tabellenblätter drucken mit Inhaltsverzeichnis
Heinz
Meine Arbeitsmappen haben ca. 100 Tabellenblätter. Mittels eines Addin werden im vordersten Tabellenblatt "Inhaltsverzeichnis" von A3 bis A102 (ggf ff) die Tabellennamen aufgelistet.
Franz (fcs) hat mir ein hervorragend funkionierendes Makro (mein erstes hier) zum Löschen von Zeilen des Inhaltsverzeichnises und der zugehörigen Tabellenblätter geschrieben (Zeile oder Zelle in der Zeile markieren - Makrobutton - msg-box - ja- Zeile(n) und Bla(e)tt(er) gelöscht - Super.
Nach Entfernen der Zeilenlöschfunktion und ersetzen von delete durch printout (eigene Versuche) funktioniert das Makro erstaunlicherweise genauso gut zum Drucken der so ausgewählten Blätter.
In manchen Fällen würde ich mir gerne die Druckauswahl speichern (z. B. zum wiederholten Drucken)
Mein Fragen/Bitten wären deshalb Folgende:
a) Was muss ich bitte in dem unten folgenden Makro ändern, damit die Tabellenblätter gedruckt werden, die ich hinter den jeweiligen Blattnamen in Spalte A in Spalte B mit einem x kennzeichne?
b) Wie kann ich bitte dazu einen bestimmten Drucker (FreePDF-Multidoc) anstelle des Standarddruckers vorgeben?
Sub BlaetterDrucken_mit_Inhaltsverzeichnis_H2()
'Die folgende Prozedur kannst Du z.B. per Buttonklick starten,
'nachdem Du die zu druckenden Zeilen markiert hast.
'Die Markierungen kannst Du auch in Spalte B machen.
'Du kannst Blöcke selektieren oder auch mehrere einzelne Zeilen
'(bei gedrückter Strg-Taste).
Dim rngSelektion As Range, Zeile As Range, lNr As Long, _
strBlatt As String, arrZeilen() As Long, arrBlatt() As String
lNr = 0
If MsgBox("Blätter in markierten Zeilen Drucken?", vbQuestion + vbYesNo, _
"Blätter Drucken") = vbYes Then
'Daten der zu druckenden Blätter einlesen
Set rngSelektion = Selection
For Each Zeile In rngSelektion.Rows
If Zeile.Row >= 3 And _
fncCheckSheet(ActiveWorkbook, Worksheets(1).Cells(Zeile.Row, 1).Text) = True Then
lNr = lNr + 1
ReDim Preserve arrZeilen(1 To lNr)
ReDim Preserve arrBlatt(1 To lNr)
arrZeilen(lNr) = Zeile.Row
arrBlatt(lNr) = Worksheets(1).Cells(Zeile.Row, 1)
Else
'Blatt mit Name in Spalte A ist nicht vorhanden
Worksheets(1).Cells(Zeile.Row, 2) = "Blatt nicht vorhanden"
End If
Next
If lNr > 0 Then
Application.ScreenUpdating = False
'Blätter drucken
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(arrBlatt).PrintOut
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End If
End Sub
Function fncCheckSheet(wb As Workbook, varBlatt) As Boolean
'Prüft ob Blatt in Arbeitsmappe vorhanden
Dim objSheet As Object
For Each objSheet In wb.Sheets
If objSheet.Index = varBlatt Or LCase(objSheet.Name) = LCase(varBlatt) Then
fncCheckSheet = True
Exit For
End If
Next
End Function