Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1664to1668
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

bei bestimmten Datum Tabellenblätter löschen

bei bestimmten Datum Tabellenblätter löschen
10.01.2019 03:05:23
Bernd
Hallo zusammen,
möchte gerne bei erreichen eines bestimmten Datums (z.b. 31.12.2019)
alle Tabellenblätter, bis auf ein bestimmtes, einer Excel Mappe beim Start, ohne nachfrage, löschen.
Teilweise sind die Blätter ausgeblendet.
Habe schon das Internet durchsucht, aber leider nichts passendes gefunden.
Vielen Dank schon einmal im voraus
Bernd

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Tabellenblätter zu einem bestimmten...
10.01.2019 06:03:09
Case
Hallo, :-)
... Datum löschen - alle bis auf Eines (alle löschen würde auch nicht gehen): ;-)
Option Explicit
Private Sub Workbook_Open()
Dim wksSheet As Worksheet
On Error GoTo Fin
Application.ScreenUpdating = False
If Date = "10.01.2019" Then ' Datum anpassen!!!!
Application.DisplayAlerts = False
For Each wksSheet In ThisWorkbook.Worksheets
If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
If wksSheet.Name  "Zusammenfassung" Then
wksSheet.Delete
End If
Next wksSheet
End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Code gehört in "DieseArbeitsmappe"!
Servus
Case

Anzeige
AW: Tabellenblätter zu einem bestimmten...
10.01.2019 19:23:41
Bernd
Hallo Case,
Danke für Deine Hilfe, werde es nachher mal versuchen, habe noch fragen dazu.
"Zusammenfassung" ist der Name der Tabelle die nicht gelöscht wird ?
Besteht noch die möglichkeit nach dem löschen der Tabellenblätter die Datei gleich automatisch zu speichern?
Vielen Dank und noch einen schönen Abend
BErnd
Probiere es dann mal...
11.01.2019 08:16:29
Case
Hallo, :-)
... so der Spur nach: ;-)
Option Explicit
Private Sub Workbook_Open()
Dim wksSheet As Worksheet
On Error GoTo Fin
Application.ScreenUpdating = False
With ThisWorkbook
If Date = "11.01.2019" Then ' Datum anpassen!!!!
Application.DisplayAlerts = False
For Each wksSheet In .Worksheets
If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
If wksSheet.Name  "Zusammenfassung" Then
wksSheet.Delete
End If
Next wksSheet
End If
.Save
'.Close False ' Gleich schliessen
End With
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Und ja - das Tabellenblatt, das nicht gelöscht wird heißt "Zusammenfassung".
Servus
Case

Anzeige
AW: Probiere es dann mal...
11.01.2019 22:16:06
Bernd
Super, Danke Dir viel mals
Wünsche Dir ein schönes Wochenende
AW: Probiere es dann mal...
15.01.2019 03:59:31
Bernd
Hallo,
benötige nochmals Eure Hilfe.
obiges Funktioniert ohne Probleme, mit Dank an Case, sobald das bestimmte Datum erreicht ist, werden alle blätter bis auf eines gelöscht und die Mappe gespeichert.
Habe jetzt nur festgestellt, wenn mman die Arbeitsmappe schließt,sollange das "Verfallsdatum" nicht erreicht ist, wird diese ohne nachfrage gespeichert, das sollte nicht sein.
Also bis zum "Verfallsdatum" schließen ohne Speichern und ohne nachfrage, nur ich sollte speichern können.
Da ich schon den Anmelde namen aus Windows (z.b. A123BCD) in der Mappe einlese wegen Benutzersteuerung, sollte dieses auch darüber laufen.
Wenn das "Verfallsdatum" erreicht ist, soll weiterhin obiges laufen, also mit Speichern.
Hoffe Ihr könnt mir Helfen.
Vielen Dank schon mal im voraus
Bernd
Anzeige
Das ".Save" muss dann an eine...
15.01.2019 08:41:28
Case
Hallo, :-)
... andere Stelle: ;-)
Option Explicit
Private Sub Workbook_Open()
Dim wksSheet As Worksheet
On Error GoTo Fin
Application.ScreenUpdating = False
With ThisWorkbook
If Date = "11.01.2019" Then ' Datum anpassen!!!!
Application.DisplayAlerts = False
For Each wksSheet In .Worksheets
If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
If wksSheet.Name  "Zusammenfassung" Then
wksSheet.Delete
End If
Next wksSheet
.Save
'.Close False ' Gleich schliessen
End If
End With
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Servus
Case

Anzeige
AW: Das ".Save" muss dann an eine...
15.01.2019 21:02:44
Bernd
Hallo Case,
vielen Dank für Deine hilfe.
jetzt geht fast gar nichts mehr, habe das alte mit "'" Deaktivert, das neue eingefügt, jetzt bekomme ich für fehler im Debugger. Habe schon einiges Versucht, bekomme es nicht so hin.
Bei normalem schliessen,also im Aktivem zeitraum, sollte geschlossen werden ohne speichern und ohne nachfrage ob gespeichert werden sollte. Wenn es möglich ist, sollte nur ich (über USer ID) die frage bekommen ob ich speichern möchte
Ich hänge mal den Code dran. Hoffe Du kannst mir dabei noch mal Helfen.
Vielen Dank schon mal im voraus
Bernd
---------------------------------------------------
Private Sub Workbook_Open()
Dim wksSheet As Worksheet
On Error GoTo Fin
Application.ScreenUpdating = False
With ThisWorkbook
If Date = "31.12.2019" Then ' Datum anpassen!!!!
Application.DisplayAlerts = False
For Each wksSheet In .Worksheets
If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
If wksSheet.Name  "Startblatt" Then
wksSheet.Delete
End If
Next wksSheet
.Save
'.Close False ' Gleich schliessen
End If
End With
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim strBerechtigt As String
strBerechtigt = Environ("Username")
Application.ScreenUpdating = False
If WorksheetFunction.CountIf(Worksheets("Berechtigungen").Columns(2), strBerechtigt) > 0 Then
If strBerechtigt = "P474HYU" Then
Worksheets("Startblatt").Visible = True
Worksheets("Fahrzeug1").Visible = True
Worksheets("Fahrzeug2").Visible = True
Worksheets("Fahrzeug3").Visible = True
Worksheets("ZRB").Visible = True
Worksheets("DispoÜbergabe").Visible = True
Worksheets("ZRB-Eingang 1-20").Visible = True
Worksheets("ZRB-Eingang 21-40").Visible = True
Worksheets("Stofftabelle").Visible = True
Worksheets("Berechtigungen").Visible = True
Worksheets("Adressen").Visible = True
Else
Worksheets("Startblatt").Visible = False
Worksheets("Fahrzeug1").Visible = True
Worksheets("Fahrzeug2").Visible = True
Worksheets("Fahrzeug3").Visible = True
Worksheets("ZRB").Visible = True
Worksheets("DispoÜbergabe").Visible = True
Worksheets("ZRB-Eingang 1-20").Visible = True
Worksheets("ZRB-Eingang 21-40").Visible = True
Worksheets("Stofftabelle").Visible = fals
Worksheets("Berechtigungen").Visible = fals
End If
Else
MsgBox "Sie sind nicht berechtigt die Datei zu öffnen."
ThisWorkbook.Close False
End If
Sheets("Fahrzeug1").ScrollArea = "A$1:$S$74"
Sheets("Fahrzeug2").ScrollArea = "A$1:$S$74"
Sheets("Fahrzeug3").ScrollArea = "A$1:$S$74"
Sheets("ZRB").ScrollArea = "A$1:$O$53"
'Sheets("DispoÜbergabe").ScrollArea = "A$1:$G$41"
Sheets("ZRB-Eingang 1-20").ScrollArea = "A$1:$K$30"
Sheets("ZRB-Eingang 21-40").ScrollArea = "A$1:$K$30"
Application.CalculateFull
End Sub

'speichern
'

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Dim ws As Worksheet
'For Each ws In ThisWorkbook.Worksheets
'    If ws.Name = "Startblatt" Then
'        ws.Visible = True
'    Else
'        ws.Visible = xlVeryHidden
'        ThisWorkbook.Close savechange: fals
'    End If
'Next ws
'End Sub

'-------------------------------------------------------------------
'

Private Sub Workbook_Open()
'Dim strBerechtigt As String
'strBerechtigt = Environ("Username")
'Application.ScreenUpdating = False
'If WorksheetFunction.CountIf(Worksheets("Berechtigungen").Columns(2), strBerechtigt) > 0 Then
'    If strBerechtigt = "P474HYU" Then
'        Worksheets("Startblatt").Visible = True
'        Worksheets("Fahrzeug1").Visible = True
'        Worksheets("Fahrzeug2").Visible = True
'        Worksheets("Fahrzeug3").Visible = True
'        Worksheets("ZRB").Visible = True
'        Worksheets("DispoÜbergabe").Visible = True
'        Worksheets("ZRB-Eingang 1-20").Visible = True
'        Worksheets("ZRB-Eingang 21-40").Visible = True
'        Worksheets("Stofftabelle").Visible = True
'        Worksheets("Berechtigungen").Visible = True
'        Worksheets("Adressen").Visible = True
'    Else
'        Worksheets("Startblatt").Visible = False
'        Worksheets("Fahrzeug1").Visible = True
'        Worksheets("Fahrzeug2").Visible = True
'        Worksheets("Fahrzeug3").Visible = True
'        Worksheets("ZRB").Visible = True
'        Worksheets("DispoÜbergabe").Visible = True
'        Worksheets("ZRB-Eingang 1-20").Visible = True
'        Worksheets("ZRB-Eingang 21-40").Visible = True
'        Worksheets("Stofftabelle").Visible = Fals
'        Worksheets("Berechtigungen").Visible = Fals
'    End If
'Else
'    MsgBox "Sie sind nicht berechtigt die Datei zu öffnen."
'    ThisWorkbook.Close False
'End If
'   Sheets("Fahrzeug1").ScrollArea = "A$1:$S$74"
'    Sheets("Fahrzeug2").ScrollArea = "A$1:$S$74"
'    Sheets("Fahrzeug3").ScrollArea = "A$1:$S$74"
'    Sheets("ZRB").ScrollArea = "A$1:$O$53"
'    'Sheets("DispoÜbergabe").ScrollArea = "A$1:$G$41"
'    Sheets("ZRB-Eingang 1-20").ScrollArea = "A$1:$K$30"
'    Sheets("ZRB-Eingang 21-40").ScrollArea = "A$1:$K$30"
'    Application.CalculateFull
'AB HIER LAUFZEIT
'Dim wksSheet As Worksheet
'    On Error GoTo Fin
'    Application.ScreenUpdating = False
'    With ThisWorkbook
'        If Date = "31.12.2019" Then ' Datum anpassen!!!!
'            Application.DisplayAlerts = False
'            For Each wksSheet In .Worksheets
'                If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
'                If wksSheet.Name  "Startblatt" Then
'                    wksSheet.Delete
'                End If
'            Next wksSheet
'        End If
'        .Save
'.Close False ' Gleich schliessen
'   End With
'Fin:
'    Application.ScreenUpdating = True
'    Application.DisplayAlerts = True
'End Sub
'--------------------------------------------------------------
'-SPEICHERN NUR MIT PWD MÖGLICH
'Option Explicit
'

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Dim speichern As String
'speichern = InputBox("Speichern ist nur nach Eingabe" & Chr(10) & "eines Passworts möglich !")
'If speichern = "BBSUN99" Then
'Exit Sub
'Else
'MsgBox ("Falsches Passwort bzw. Speicherung abgebrochen !")
'Cancel = True
'End If
'End Sub

'----------------------------------------------------------------
Anzeige
AW: Das ".Save" muss dann an eine...
15.01.2019 21:41:44
Bernd
..
AW: Das ".Save" muss dann an eine...CLOSE
15.01.2019 23:46:46
Bernd
Hallo zusammen,
habe es nach langem testen hinbekommen, läuft jetzt alles ohne Probleme.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige