AW: Leere Zeile + Spalten löschen
22.09.2005 21:40:59
Aton
Sub LeereZeilenSpaltenLöschen()
Dim LZeile As Long, LSpalte As Long
Dim Letzte As Long, Zeile As Long, Spalte As Long
Dim i As Integer, TopPos As Integer
Dim DruckDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim CB As CheckBox
Application.ScreenUpdating = False
Set CurrentSheet = ActiveSheet
Set DruckDlg = ActiveWorkbook.DialogSheets.Add
DruckDlg.CheckBoxes.Add 78, 40, 70, 16.5
DruckDlg.CheckBoxes(1).Text = "Leere Zeilen"
DruckDlg.CheckBoxes.Add 78, 53, 70, 16.5
DruckDlg.CheckBoxes(2).Text = "Leere Spalten"
DruckDlg.Buttons.Left = 200
With DruckDlg.DialogFrame
.Height = Application.Max(68, DruckDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Leere Elemente zum Löschen auswählen"
End With
DruckDlg.Buttons("Button 2").BringToFront
DruckDlg.Buttons("Button 3").BringToFront
LZeile = False
LSpalte = False
CurrentSheet.Activate
If DruckDlg.Show Then
If DruckDlg.CheckBoxes(1).Value = xlOn Then LZeile = True
If DruckDlg.CheckBoxes(2).Value = xlOn Then LSpalte = True
End If
Application.DisplayAlerts = False
DruckDlg.Delete
CurrentSheet.Activate
If LZeile Then
Letzte = ActiveSheet.UsedRange.Rows.Count
For Zeile = Letzte To 1 Step -1
If Application.CountA(ActiveSheet.Rows(Zeile)) = 0 Then ActiveSheet.Rows(Zeile).Delete
Next Zeile
End If
If LSpalte Then
Letzte = ActiveSheet.UsedRange.Columns.Count
For Spalte = Letzte To 1 Step -1
If Application.CountA(ActiveSheet.Columns(Spalte)) = 0 Then ActiveSheet.Columns(Spalte).Delete
Next Spalte
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub