Frage noch?
04.08.2006 15:16:36
Jeanette
hier mein Code:
Option Explicit
Private Sub ComboBox1_Change()
If bolEntry = False Then
Sheets(ComboBox1.Value).Select
End If
End Sub
Private Sub CommandButton1_Click()
Leer
End Sub
Private Sub CommandButton2_Click()
Leer01
End Sub
Private Sub ComboBox2_Change()
If bolEntry = False Then
If MsgBox("Bist Du sicher das Du das ABl vom '" & ComboBox2 & "' löschen willst ?", vbYesNo, " Nachfrage löschen !") = vbYes Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(ComboBox2.Text).Delete
Application.DisplayAlerts = True
fcnCBLaden
End If
End If
End Sub
Private Sub Worksheet_Activate()
Dim i As Integer
bolEntry = True
With Sheets(1).ComboBox1
.Clear
For i = 1 To Worksheets.Count - 3
.AddItem Worksheets(i).Name
Next
.ListIndex = 0
End With
bolEntry = False
End Sub
Sub Leer()
Dim StrName As String
Dim wks As Worksheet
Dim i As Integer
StrName = InputBox("Neuer Name?")
If prcPruefeName(StrName) = False Then
MsgBox "Der Name " & StrName & " ist bereits vergeben oder er enthält unzulässige Zeichen !", vbCritical
Exit Sub
End If
If StrName <> "" Then
Sheets("Leer").Copy After:=Sheets(1)
Set wks = ActiveSheet
wks.Name = StrName
Call prcSortieren(wks)
End If
End Sub
Sub Leer01()
Dim StrName As String
Dim wks As Worksheet
Dim i As Integer
StrName = InputBox("Neuer Name?")
If prcPruefeName(StrName) = False Then
MsgBox "Der Name " & StrName & " ist bereits vergeben oder er enthält unzulässige Zeichen !", vbCritical
Exit Sub
End If
If StrName <> "" Then
Sheets("Leer 01").Copy After:=Sheets(1)
Set wks = ActiveSheet
wks.Name = StrName
Call prcSortieren(wks)
End If
End Sub
Sub prcSortieren(wks As Worksheet)
Dim i As Integer
For i = 2 To Worksheets.Count - 1
If UCase(Sheets(i).Name) > UCase(wks.Name) Then
wks.Move before:=Sheets(i)
Exit Sub
End If
Next
wks.Move before:=Sheets(Sheets.Count - 1)
End Sub
Function prcPruefeName(strBlattName As String) As Boolean
Dim notAllowed As Variant
Dim wksSheets As Worksheet
Dim intIndex As Integer
'Im Tabellennamen nicht zulässige Zeichen
notAllowed = Array(":", "\", "/", "?", "*", "[", "]")
'Prüfen ob unerlaubte Zeichen vorhanden
For intIndex = 0 To UBound(notAllowed)
If InStr(1, strBlattName, notAllowed(intIndex)) > 0 Then
prcPruefeName = False
Exit Function
End If
Next
For Each wksSheets In ThisWorkbook.Worksheets
If UCase(wksSheets.Name) = UCase(strBlattName) Then
prcPruefeName = False
Exit Function
End If
Next wksSheets
prcPruefeName = True
End Function
Dazu habe ich ein Frage: Die Kombobox zum direkten Auswahl der Blätter aktualisiert sich sofort nach dem ein Blatt eingefügt bzw. gelöscht wird.
Die Kombobox zum löschen der Blättermacht das aber nicht, ist das so normal, oder gehört da wo im Code etwas geändert, wenn ja, wie sieht das dann aus?
Recht herzlichen Dank allen.
LG Jeanette