nur ein Tabellenblatt erlauben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetActivate(ByVal sh As Object) If ThisWorkbook.Sheets.Count > 1 Then MsgBox ("Sie haben ein neues Tabellenblatt eingefügt. " _ & "Beim Speichern der Datei werden alle Tabellenblätter mit Ausnahme des ersten gelöscht! " _ & "Verwenden Sie für eine neue Meldung bitte eine neue Datei!") End If End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim sh As Object If ThisWorkbook.Sheets.Count > 1 Then For Each sh In ThisWorkbook.Sheets If sh.Index > 1 Then Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True End If Next sh End If ThisWorkbook.Sheets(1).Name = "Meldeblatt" End Sub

Hallo Martin, hallo Uwe,
Uwe hat völlig recht. Bei vertauschter Reihenfolge wird das falsche Blatt gelöscht. Ich hab daher eine weitere Variante geschrieben, in der ich die Blätter über den Namen anspreche, wie von Uwe vorgeschlagen. Gibt es nur 1 Blatt, wird dieses "Meldedaten" benannt und die Datei wird gespeichert. Gibt es mehrere Blätter und eines heißt "Meldedaten", werden die anderen Blätter gelöscht und die Datei wird gespeichert. Gibt es kein Blatt mit dem Namen "Meldedaten", wird der User aufgefordert eines der Blätter entsprechend zu benennen und die Datei wird nicht gespeichert.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object, BName As String
If ThisWorkbook.Sheets.Count > 1 Then
For Each sh In ThisWorkbook.Sheets
If sh.Name = "Meldeblatt" Then BName = "Meldeblatt"
Next sh
If BName = "Meldeblatt" Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Else
MsgBox ("Die Datei enthält mehrere Blätter. " & _
"Es kann jedoch nur ein Blatt gespeichert werden. " & _
"Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _
"den Namen " & Chr$(34) & "Meldedaten" & Chr$(34) & " geben. Alle anderen Blätter " & _
"werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _
"eine eigene Datei.")
Cancel = True
End If
Else
ThisWorkbook.Sheets(1).Name = "Meldedaten"
End If
End Sub

Gruß Ingolf

Hallo Ingolf und natürlich auch hallo Uwe
Ihr beiden sprengt ja den Rahmen.
Daran hatte ich noch gar nicht gedacht.... seit ich Herber.de kenne habe ich meine Forum-Forbie völlig verloren.
Ich werde den Script morgen in der Früh gleich in der Meldeblatt Vorlage einbauen und testen, aber dazu ist diese Version vom Script nur bedingt geeignet. Es existiert noch eine Tabelle Very Hidden mit dem Nahmen "Querry", in der werden Daten mit MySQL aktualisiert und diese droht mir beim neuen Script zu verschwinden. IIm ersten Script konnte ich die Abfrage &gt1 auf &gt2 erweitern aber jetzt?
Geht da auch so etwas oder ähnlich?
If sh.Name &lt&gt "Meldeblatt" or "Querry" Then
Unendlich dankbar
Mit freundlichen Grüssen
Martin
PS der Einstieg in VBA ist wie ein Hürdenlauf für mich, aber jetzt schaffe ich bereits 50 Meter von den 100 Meter ohne Sturz. Dank Euch nochmals Danke

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim sh As Object, BName As String If ThisWorkbook.Sheets.Count > 2 Then For Each sh In ThisWorkbook.Sheets If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then BName = "Treffer" Next sh If BName = "Treffer" Then For Each sh In ThisWorkbook.Sheets If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True End If Next sh Else MsgBox ("Die Datei enthält mehrere Blätter. " & _ "Es kann jedoch nur ein Blatt gespeichert werden. " & _ "Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _ "den Namen " & Chr$(34) & "Meldedaten" & Chr$(34) & " geben. Alle anderen Blätter " & _ "werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _ "eine eigene Datei.") Cancel = True End If Else ThisWorkbook.Sheets(1).Name = "Meldeblatt" ThisWorkbook.Sheets(2).Name = "Querry" End If End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object) If ThisWorkbook.Sheets.Count > 2 Then MsgBox ("Sie haben ein neues Tabellenblatt eingefügt. " _ & "Beim Speichern der Datei werden alle Tabellenblätter mit Ausnahme des ersten gelöscht! " _ & "Verwenden Sie für eine neue Meldung bitte eine neue Datei!") End If End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object) Application.DisplayAlerts = False Sh.Delete Application.DisplayAlerts = True MsgBox "Es darf kein weiteres Tabellenblatt hinzugefügt werden." End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object) On Error GoTo Fehler Application.ScreenUpdating = False MsgBox "Nicht erlaubt" Application.DisplayAlerts = False ActiveSheet.Delete Fehler: Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nur ein Tabellenblatt erlauben

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread