Implementieren eines "Löschen" Buttons
20.03.2017 14:29:58
Rainer
Dabei ist anzumerken, dass durch die Prozedur alle während des arbeitens extra erzeugten Sheets, die nicht im VBA Code im Array hinterlegt sind, gelöscht werden beim beenden des Programmes. Das untenstehende Programm funktioniert auch wie gewünscht.
Allerdings ist es nun so, dass ich einen Button zusätzlich implementieren soll, der wie die Prozedur beim schließen, die manuell erzeugten Sheets löscht. Das Programm ansich soll aber geöffnet bleiben.
Hat jemand dazu eine Idee wie dies umzusetzen ist?
Danke vorab!
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Erzeugte kundenspezifische Tabellen die nicht in der Liste sind entfernen
Dim Arr_wks()
Dim wks As Worksheet
Dim i As Integer
Dim weg_damit As Boolean
Dim blatt_obj As Object
' Ausschalten der Bildschirmanimation
Application.ScreenUpdating = False
' Alle Blätter zur Bearbeitung entsperren
ActiveWorkbook.Unprotect Password:=getPw()
For Each blatt_obj In Sheets
If blatt_obj.Name Sheets("Tabelle1").Name Then
If blatt_obj.Visible = False Then
blatt_obj.Visible = True
End If
End If
blatt_obj.Protect UserInterfaceOnly:=False, DrawingObjects:=False, Contents:=False, _
Scenarios:=False, Password:="123456"
Next blatt_obj
' Array der Arbeitsblätter die NICHT gelöscht werden sollen
Arr_wks = Array("Tabelle1", "Tabelle2", "Tabelle3")
' For-Schleife durchläuft alle Elemente von links nach rechts im Array, ist i im Array _
vorhanden wird "weg_damit" auf false gesetzt und die For-Schleife abgebrochen
For Each wks In ThisWorkbook.Worksheets
For i = LBound(Arr_wks) To UBound(Arr_wks)
If wks.Name Arr_wks(i) Then
weg_damit = True
Else
weg_damit = False
Exit For
End If
Next i
If weg_damit = True Then
wks.Visible = xlSheetVisible
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
' löschen des Arbeitsblatts ohne Nachfrage
End If
weg_damit = False
Next wks
' Alle Blätter bis auf Tabelle1 wieder ausblenden und sperren
ActiveWorkbook.Unprotect Password:="123456"
For Each blatt_obj In Sheets
If blatt_obj.Name Sheets("Tabelle1").Name Then
If blatt_obj.Visible = True Then
blatt_obj.Visible = False
End If
End If
blatt_obj.Protect UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:=getPw()
Next blatt_obj
ActiveWorkbook.Protect Password:=getPw()
ThisWorkbook.Save 'Datei speichern
Application.ScreenUpdating = True
End Sub