Eintrag aus allen übrigen Comboboxen löschen
02.01.2013 15:04:12
Mexsalem
ich habe in einer Userform ca. 40 Comboboxen, die ich zuerst mit folgenden Einträgen initialisiere.
Private Sub UserForm_Initialize()
Dim i As Integer, iSpaltenname As Integer
Dim sAddress As String
'1.Combobox mit den Tabellennamen füllen
cbo_Zieltabelle.Clear
For i = 1 To Worksheets.Count
cbo_Zieltabelle.AddItem Worksheets(i).Name
Next
cbo_Zieltabelle.ListIndex = 0
'Jede weitere ComboBox mit den Spaltennamen füllen
' nur alle sichtbaren Spalten des UsedRange ermitteln
' und als Eintrag in ComboBox mit oder ohne Spalten-
' überschrift übernehmen
For Each ctrl In Controls
If TypeName(ctrl) = "ComboBox" And _
ctrl.Name "cbo_Zieltabelle" Then
ctrl.AddItem "Bitte Spalte auswählen" '
For iSpaltenname = 1 To ActiveSheet.UsedRange.Columns.Count
If ActiveSheet.Cells(1, iSpaltenname) "" And _
ActiveSheet.Columns(iSpaltenname).Hidden = False Then
sAddress = ActiveSheet.Cells(1, iSpaltenname).Address
sAddress = Mid(sAddress, InStr(sAddress, "$") + 1, _
InStr(2, sAddress, "$") - 2)
ctrl.AddItem "Spalte " & sAddress & " - " & _
ActiveSheet.Cells(1, iSpaltenname)
ElseIf ActiveSheet.Columns(iSpaltenname).Hidden = False Then
sAddress = ActiveSheet.Cells(1, iSpaltenname).Address
sAddress = Mid(sAddress, InStr(sAddress, "$") + 1, _
InStr(2, sAddress, "$") - 2)
ctrl.AddItem "Spalte " & sAddress
End If
Next iSpaltenname
End If
Next ctrl
End Sub
Die Comboxen befinden sich sowohl innerhalb, als auch ausserhalb eines Frames.
Mein bisheriger Ansatz den Eintrag zu löschen scheitert leider, kann mir jemand helfen ? Der Aufruf erfolgt aus allen Comboboxen über das Change-Ereignis und ruft eine Function auf :
Private Sub cbo_IndividuellerName_Change()
AusgewähltenEintragLöschen IndividuellerName
End Sub
Function AusgewähltenEintragLöschen(ActiveCombobox)
Dim MyListIndex
Dim ctrl As Object
MyListIndex = ActiveCombobox.ListIndex
If MyListIndex > -1 Then
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" And _
ctrl.Name ActiveCombobox And _
ctrl.Name "cbo_Zieltabelle" And _
ctrl.Enabled = True Then
ctrl.RemoveItem MyListIndex
' verursacht Laufzeitfehler 80004005 :
' "Nicht näher bezeichneter Fehler"
End If
Next ctrl
End If
End Function
Mexsalem