Selektiertes Drucken v. Sheets und Bereichen

Moin Excellianer!!
Ich weiß!! ...und ich habe auch schon viel zum Thema Drucken im Archiv gelesen und gefunden... ...aber leider nix passendes gefunden... ;-((
Die Vorgaben sind:
Ein Tabellenblatt, bei dem die Spaltenköpfe als Überschrift bzw. "wiederkehrende Zeilen" gesetzt sind.
In dem Bereich, in dem Eingaben via UserForm eingetragen werden, machen mir "bedingte Formatierungen" bei Werteintrag Rahmen um die Zellen. Das geht von der Zeile 16 bis zur Zeile 5000
Meine Fragen sind:
1. Kann man die Druckfunktion in der Exceldatei auf ausgewählte Blätter beschränken? Ich vermute, dass ich da meiner AutoOpen-Routine etwas hinzufügen müsste?!!
2. Die zum Ausdruck freigegebenen Tabellenblätter sollen nur (!) den Bereich der Reihe nach ausdrucken, der mit Werten befüllt ist. Ich möchte die Seiten, die ausgedruckt werden sollen nicht manuell im Druck-Manager eintragen. Das sollte automatisch geschehen.
-------------------------------
Es würde mich nicht stören, wenn die die Druckfunktion der gesamten Exceldatei zu erst kpl. außer Kraft gesetzt werden muss, um sie dann meinen Vorstellungen entsprechend durch eigene CommandButton und/oder Menü-Einträge sowie einem VBA-Skript neu zu gestalten.
Vielen Dank!!
Viele Grüße aus dem hohen Norden
Lenni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lenni,
die folgende BeforePrint-Prozedur prüft die Namen der zu druckenden Blätter und bricht ggf. den Druckvorgang ab.
Ob die Sub-Routine für den Druckbereich erforderlich ist hängt von den Daten/Formaten in den Tabellenblättern ab. Ggf. muss die Prozedur auch noch angepasst werden.
Einfügen muss du die Prozeduren im VBA-Editor unter "DieseArbeitsmappe" der Datei.
Gruß
Franz


Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Blatt As Object, bolAbbruch As Boolean
'Prüfen des/der zum Drucken gewählten Blatts/Blätter
For Each Blatt In ActiveWindow.SelectedSheets
Select Case Blatt.Name
Case "NoPrint1", "NoPrint2"
'Namen der nicht zu druckenden Blätter
MsgBox "Das Blatt " & Blatt.Name & " darf nicht gedruckt werden!" & vbLf & _
"Druckvorgang wird abgebrochen"
bolAbbruch = True
Exit For
Case Else
'do nothing
End Select
Next
If bolAbbruch = True Then
'Abbruch des Druckvorgangs/der Seitenvorschau
Cancel = True
Else
'Sub-Routine zur Aufbereitung des Druckbereichs der Tabellenblätter aufrufen
Call Druckbereich
End If
End Sub
Private Sub Druckbereich()
Dim Blatt As Object, wks As Worksheet, lngLastRow As Long, lngSpalte
'Aufbereiten des Druckbereichs der selektierten Tabellenblätter
For Each Blatt In ActiveWindow.SelectedSheets
If Blatt.Type = xlWorksheet Then
Set wks = Blatt
lngLastRow = 0
With wks
'Letzte Zeile mit Dateneinträgen im Blatt ermitteln
For lngSpalte = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
If .Cells(.Rows.Count, lngSpalte).End(xlUp).Row > lngLastRow Then
lngLastRow = .Cells(.Rows.Count, lngSpalte).End(xlUp).Row
End If
Next
'Druckbereich setzen
'### ggf. Startzeile und Spalten des Druckbereichs anpassen
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(lngLastRow, 7)).Address
End With
Else
'Diagramme und andere Nicht-Tabellenblätter
'do nothing
End If
Next
End Sub

Private Sub Druckbereich() Dim Blatt As Object, wks As Worksheet, lngLastRow As Long, lngSpalte Dim lngSpalte1 As Long, lngSpalteL As Long, lngZeile1 As Long 'Aufbereiten des Druckbereichs der selektierten Tabellenblätter For Each Blatt In ActiveWindow.SelectedSheets If Blatt.Type = xlWorksheet Then Set wks = Blatt lngLastRow = 0 With wks 'Basiswerte für Druckbereich lngZeile1 = 1 lngSpalte1 = 1 lngSpalteL = .Cells.SpecialCells(xlCellTypeLastCell).Column Select Case wks.Name Case "Tabelle1" lngZeile1 = 16: lngSpalteL = 7 'Für Druckbereich letzte Zeile mit Wert in Spalte A ermitteln lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row Case "Tabelle2" lngZeile1 = 2: lngSpalteL = 5 Case Else 'do nothing - Basiswerte verwenden End Select If lngLastRow = 0 Then 'Wenn letzte zu druckende Zeile nicht in den Case-Anweisungen ermittelt, _ dann letzte Zeile mit Dateneinträgen im Blatt über alle Spalten ermitteln For lngSpalte = lngSpalte1 To lngSpalteL If .Cells(.Rows.Count, lngSpalte).End(xlUp).Row > lngLastRow Then lngLastRow = .Cells(.Rows.Count, lngSpalte).End(xlUp).Row End If Next End If 'Druckbereich setzen .PageSetup.PrintArea = .Range(.Cells(lngZeile1, lngSpalte1), _ .Cells(lngLastRow, lngSpalteL)).Address End With Else 'Diagramme und andere Nicht-Tabellenblätter 'do nothing End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Selektiertes Drucken v. Sheets und Bereichen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Selektiertes Drucken v. Sheets und Bereichen

4 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)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread