Zellen und Spalten ausserhalb Druckbereich löschen

Forumthread: Zellen und Spalten ausserhalb Druckbereich löschen

14.07.2006 10:16:59

Peter

Liebes Forum
Ich möchte gerne in einem Workbook alle Zeilen und Spalten ausserhalb des Druckbereichs, sofern es einen solchen gibt, löschen.
Kann mir da jemand auf die Sprünge helfen?
Danke Peter


Sub Nur_Druckbereich()
Dim Wkb As Workbook
Dim Ws As Worksheet
Set WkB = ThisWorkbook
For Each Ws in Wkb.Worksheets
'Prüfen ob in diesem Worksheet Druckbereich vorhanden
'wenn ja, alle Zeilen und Spalten ausserhalb löschen
Next Ws
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zellen und Spalten ausserhalb Druckbereich löschen

14.07.2006 14:34:49

Martin

Hallo Peter,
versuch mal


Sub Nur_Druckbereich()
Dim Wkb As Workbook
Dim Ws As Worksheet
Set Wkb = ThisWorkbook
For Each Ws In Wkb.Worksheets
On Error GoTo errorhandler
z1 = Range(Ws.PageSetup.PrintArea).Rows(1).Row - 1
z2 = Range(Ws.PageSetup.PrintArea).Rows(1).Row + Range(Ws.PageSetup.PrintArea).Rows.Count
s1 = Range(Ws.PageSetup.PrintArea).Columns(1).Column - 1
s2 = Range(Ws.PageSetup.PrintArea).Columns(1).Column + Range(Ws.PageSetup.PrintArea).Columns.Count
Ws.Range(Ws.Cells(1, s2), Ws.Cells(1, 256)).EntireColumn.Delete
If s1 > 0 Then Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, s1)).EntireColumn.Delete
Ws.Range(Ws.Cells(z2, 1), Ws.Cells(65536, 1)).EntireRow.Delete
If z1 > 0 Then Ws.Range(Ws.Cells(1, 1), Ws.Cells(z1, 1)).EntireRow.Delete
errorhandler:
Next Ws
End Sub

Gruß
Martin Beck

AW: Zellen und Spalten ausserhalb Druckbereich lös

14.07.2006 15:15:11

Dan

Hallo Peter. Hier der Code. Gruss Dan.
Option Explicit
Public


Sub Nur_Druckbereich()
On Error GoTo Err_Nur_Druckbereich
Dim Wkb As Workbook
Dim Ws As Worksheet
Dim rngDruckBereich As Range
Set Wkb = ThisWorkbook
For Each Ws In Wkb.Worksheets
'Prüfen ob in diesem Worksheet Druckbereich vorhanden
Set rngDruckBereich = Druckbereich(Ws)
If (Not rngDruckBereich Is Nothing) Then
'wenn ja, alle Zeilen und Spalten ausserhalb löschen
Call AllesAusserhalbDruckbereichLoeschen(rngDruckBereich)
End If
Next Ws
Exit Sub
Err_Nur_Druckbereich:
MsgBox Err.Description, vbCritical, "Error in Nur_Druckbereich"
End Sub

Public


Function Druckbereich(ByRef io_Worksheet As Worksheet) As Range
Dim strDruckBereich As String
Set Druckbereich = Nothing
strDruckBereich = io_Worksheet.PageSetup.PrintArea
On Error Resume Next
Set Druckbereich = io_Worksheet.Range(strDruckBereich)
End Function

Public


Sub AllesAusserhalbDruckbereichLoeschen(ByRef io_rngDruckBereich As Range)
Dim rngCell As Range
For Each rngCell In io_rngDruckBereich.Worksheet.UsedRange.Cells
If (Intersect(rngCell, io_rngDruckBereich) Is Nothing) Then rngCell.Clear
Next rngCell
End Sub

AW: Zellen und Spalten ausserhalb Druckbereich lös

14.07.2006 16:50:56

Peter

Hi Dan
Das läuft perfekt!
Herzlichen Dank
Peter

Beliebteste Forumthreads (12 Monate)

Zellen und Spalten ausserhalb Druckbereich löschen

Forumthread: Zellen und Spalten ausserhalb Druckbereich löschen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zellen und Spalten ausserhalb Druckbereich löschen

Forumthread: Zellen und Spalten ausserhalb Druckbereich löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread