|
Hy
Kann Mann irgend wie dieses Makro so umbauen das er nicht drukt sondern an Email sendet
[code]
Sub DruckenTest()
Dim i As Long
Dim rngAnzahl() As Range, rngGesamt As Range, rngTeil As Range
Set rngGesamt = Range("A2:A" & Rows.Count) 'Filterbereich ohne Überschriften
On Error GoTo Raus
Set rngTeil = rngGesamt
ReDim rngAnzahl(0 To 0)
Do
Set rngAnzahl(UBound(rngAnzahl)) = rngTeil.Cells(1)
Set rngTeil = rngTeil.ColumnDifferences(rngTeil.Cells(1))
ReDim Preserve rngAnzahl(UBound(rngAnzahl) + 1)
Loop
Raus:
On Error GoTo 0
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
For i = 0 To UBound(rngAnzahl)
rngGesamt.ColumnDifferences(rngAnzahl(i)).EntireRow.Hidden = True
ActiveSheet.PrintPreview 'PrintOut für wirkliches Drucken
rngGesamt.ColumnDifferences(rngAnzahl(i)).EntireRow.Hidden = False
Next i
End Sub
[/code] |