AW: Drucken von ausgebelndeten Zeilen
05.12.2013 11:40:51
ausgebelndeten
Hallo
Ich habe es so gelöst:
- Druck abbrechen
- Kopie des Blattes anlegen
- alle ausgeblendeten Zeilen hinter der letzten benutzten Spalte markieren "HH"
- Filter setzen auf HH
- alle zeilen ab Zeile 2 (wegen der Überschrift) löschen
- Filter weg
- Markierung weg
- Ausdrucken
- Kopie löschen
OK?
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Fehler
Dim TB1, ZE&, RR&, CC%, i%, Drucken As Boolean
ZE = 2 'erste Zeile ggf Ändern wegen Überschrift
Set TB1 = ActiveSheet
TB1.Copy After:=Sheets(Sheets.Count)
With ActiveSheet ' das Neue
If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
RR = .Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
CC = .Cells.SpecialCells(xlCellTypeLastCell).Column + 1 'Letzte Spalte des gesamten _
Blattes+1
Application.ScreenUpdating = False
For i = ZE To RR
If .Rows(i).EntireRow.Hidden = True Then
Drucken = True
.Cells(i, CC) = "HH"
End If
Next
If Drucken = True Then
.Columns(CC).AutoFilter Field:=1, Criteria1:="HH"
.Rows(ZE & ":" & RR).Delete xlUp
.AutoFilterMode = False
.Columns(CC).Delete xlLeft
Application.EnableEvents = False
'*** neu ausdrucken ggf anpassen
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Application.EnableEvents = True
Else
MsgBox "Keine Daten zum Drucken"
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
TB1.Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.DisplayAlerts = True
End Sub
Gruß UweD