Sub
AußerDruckbereichLoeschen()
Dim
dbr
As
Range
On
Error
GoTo
Fehler
Fehlernr = 1
Set
dbr = Range(ActiveSheet.PageSetup.PrintArea)
Fehlernr = 2
If
dbr.Row > 1
Then
Loeschen Rows(
"1:"
& dbr.Row - 1)
End
If
If
dbr.Column > 1
Then
Loeschen Columns(
"A:"
& Left(Columns(dbr.Column - 1).Address, 2))
End
If
If
dbr.Column + dbr.Columns.Count - 1 < Columns.Count
Then
Loeschen Range(Columns(dbr.Column + dbr.Columns.Count), Columns(Columns.Count))
End
If
If
dbr.Row + dbr.Rows.Count - 1 < Rows.Count
Then
Loeschen Rows(dbr.Row + dbr.Rows.Count &
":"
& Rows.Count)
End
If
Exit
Sub
Fehler:
If
Fehlernr = 1
Then
MsgBox
"Es ist kein Druckbereich gesetzt!"
, vbInformation,
"AußerDruckbereich löschen"
ElseIf
Fehlernr = 2
Then
MsgBox
"unbekannter Fehler!"
, vbCritical
End
If
End
Sub
Sub
Loeschen(abr
As
Range)
abr.ClearFormats
abr.ClearContents
abr.ClearComments
End
Sub