Probleme m.Set rng = .range(.PageSetup.PrintArea)
15.08.2006 22:22:46
Peter
Vorgestern habe ich diesen Code erhalten (und ich meinte auch, augestestet).
Nun habe ich das ganze in mein Workbook, in dem es dann laufen soll, eingebaut und kriege Probleme mit
Set rng = .Range(.PageSetup.PrintArea)
Die Methode Range für das Objekt _Worksheet ist fehlgeschlagen (Laufzeitfehler 1004)
Für mich tönt das natürlich nach Bahnhof. Kann mir da jemand weiterhelfen?
Vielen Dank.
Peter
'
Sub AllesAusserDruckbereichLöschen()
Dim objWS As Worksheet
Dim rng As Range
Dim lngFirst As Long, lngLast As Long
Dim intFirst As Integer, intLast As Integer
'On Error GoTo ErrExit
GetMoreSpeed
For Each objWS In ThisWorkbook.Worksheets
With objWS
Set rng = .Range(.PageSetup.PrintArea)
If Not rng Is Nothing Then
If rng.Areas.Count = 1 Then
lngFirst = rng(1).Row
intFirst = rng(1).Column
lngLast = rng(rng.Count).Row
intLast = rng(rng.Count).Column
If lngLast < .Rows.Count Then .Range(.Cells(lngLast + 1, 1), .Cells(.Rows.Count, .Columns.Count)).Delete
If lngFirst > 1 Then .Range(.Cells(1, 1), .Cells(lngFirst - 1, .Columns.Count)).Delete
If intLast < .Columns.Count Then .Range(.Cells(1, intLast + 1), .Cells(.Rows.Count, .Columns.Count)).Delete
If intFirst > 1 Then .Range(.Cells(1, 1), .Cells(.Rows.Count, intFirst - 1)).Delete
End If
End If
End With
Next
ErrExit:
GetMoreSpeed 0
Set rng = Nothing
End Sub
Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long
With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc > 0, lngCalc, -4105)
.Cursor = xlDefault
End If
End With
End Sub