Wie kann das Einfügen eines Blattes vor dem Blatt 1 unterbinden? Es sollen nur Blätter hinter Blatt 1 einfügt werden können.
Besten Dank für Eure Hilfe.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End Sub
GrussPrivate Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
End Sub
Vielen DankSub Blatt_einfuegen()
With ThisWorkbook
.Unprotect strPW
.Worksheets.Add after:=.Sheets(.Sheets.Count)
.Protect strPW
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Name$
Dim objBut As Object
If Not Intersect(Target, Range("F6:F26")) Is Nothing Then
If Target.Value = "" Then
MsgBox "Rechtsklick nicht erlaubt, da Zelle leer ist"
Exit Sub
End If
If Len(Target.Value) > 30 Then
Name = Left(Target.Value, 30)
Else
Name = Target.Value
End If
With Sheets(Name)
.Visible = True
.Select
.UsedRange.End(xlDown).Offset(1, 0).Select
End With
Set objBut = Sheets(Name).Buttons.Add(0, 0, 75, 25)
With objBut
.OnAction = "Retour"
.Caption = "Retour"
.Name = "cmdRetour"
End With
Cancel = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim i%
Dim Blatt As Worksheet
Dim Name$
If Target.Offset(-1, 0).Value = "" Then
MsgBox "Leerzeilen nicht erlaubt, bitte direkt unterhalb des letzten Eintrags _
in Spalte F eingeben"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
If Len(Target.Value) > 30 Then
Name = Left(Target.Value, 30)
Else
Name = Target.Value
End If
If Not Intersect(Target, Range("F6:F26")) Is Nothing Then
i = Target.Row - 4
If Target.Value "" Then
If Worksheets.Count
Private Sub Retour()
Dim objBut As Object
ActiveSheet.Shapes("cmdRetour").Cut
ActiveSheet.Visible = xlVeryHidden 'False
Sheets(1).Select
End Sub
Sub Change_Codename()
ThisWorkbook.VBProject.VBComponents("Tabelle1").Properties("_codename") = "MeinBlatt"
End Sub