Wert in ComboBox wird nicht aktivert
08.08.2007 09:48:00
Josef
Wenn ich in der ListBox eine Zeile anklicke, dann werden die Werte normalerweise in Textboxen geschrieben.
Nun habe ich drei ComboBoxen in denen der angeklickte Wert in der ListBox der auch in der ComboBox enthalten ist aktiviert werden soll. Bei zwei ComboBoxen (cboNamen6 und cboNamen5) funktioniert es, bei der letzten ComboBox (cboNamen6) wird der Wert aber erst dann aktiviert, nachdem ich diese ComboBox einmal aktiviert habe.
Beim Anklicken der Zeile in der ListBox1 wird die Datensatznummer in der vierten ComboBox (ComBox35)
aktiviert und der richtige Wert sollte dann in den drei am Anfang genannten Comboboxen aktivert werden.
Was müßte ich tun, damit ich den Wert ohne Anklicken der dritten ComboBox in diese reinbekomme?
Danke
Josef
Code erste ComboBox:
Private Sub cboNamen6_Enter()
Dim aRow, iRow As Long
Dim wks As Worksheet
Set wks = Workbooks("HBHMListe.xls").Worksheets("Tabelle1")
Dim col As New Collection
cboNamen6.Clear
cboNamen5.Clear
cboNamen3.Text = ""
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 3 To aRow
With wks
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 2)
If Err = 0 Then
cboNamen6.AddItem .Cells(iRow, 2)
Else
Err.Clear
End If
End With
Next iRow
On Error GoTo 0
End Sub
Code zweite ComboBox:
Private Sub cboNamen5_Enter()
Dim aRow, iRow As Long
Dim wks As Worksheet
Set wks = Workbooks("HBHMListe.xls").Worksheets("Tabelle1")
Dim col As New Collection
cboNamen5.Clear
cboNamen3.Text = ""
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 3 To aRow
With wks
If .Cells(iRow, 2) = cboNamen6 Then
col.Add wks.Cells(iRow, 1), wks.Cells(iRow, 3)
If Err = 0 Then
cboNamen5.AddItem .Cells(iRow, 3)
Else
Err.Clear
End If
End If
End With
Next iRow
On Error GoTo 0
End Sub
Code dritte ComboBox:
Private Sub cboNamen3_Enter()
Dim aRow As Long
Dim iRow As Long
Dim wks As Worksheet
Set wks = Workbooks("HBHMListe.xls").Worksheets("Tabelle1")
Dim lCoBo As Long
'Dim col As New Collection
With cboNamen3
.Clear ' löschen ComboBox
.ColumnCount = 3 ' drei Spalten
.ColumnWidths = "1,8 cm;10 cm" ' Breite der Spalten
.ListRows = 40 ' angezeigte Zeilen
'.Height = 20 ' Höhe der ComboBox
'.Font.Size = 8 ' Schriftgröße
' .BackColor = RGB(204, 255, 204) ' Hintergrundfarbe
End With
aRow = IIf(IsEmpty(wks.Range("A65536")), wks.Range("A65536").End(xlUp).Row, 65536)
On Error Resume Next
For iRow = 3 To aRow
With wks
If .Cells(iRow, 2) = cboNamen6 _
And .Cells(iRow, 3) = cboNamen5 Then
'col.Add Workbooks("32648_3.xls").Worksheets("Tabelle1").Cells(iRow, 1), _
Workbooks("32648_3.xls").Worksheets("Tabelle1").Cells(iRow, 7)
If Err = 0 And _
wks.Cells(iRow, 3) = _
cboNamen5.Value Then
cboNamen3.AddItem ""
cboNamen3.List(lCoBo, 0) = _
wks.Cells(iRow, 5)
cboNamen3.List(lCoBo, 1) = _
wks.Cells(iRow, 6)
'cboNamen3.List(lCoBo, 2) = _
' wks.Cells(iRow, 7)
'cboNamen3.List(lCoBo, 3) = _
' wks.Cells(iRow, 5)
lCoBo = lCoBo + 1
Else
Err.Clear
End If
End If
End With
Next iRow
On Error GoTo 0
End Sub
sowie
Private Sub cboNamen3_Change()
On Error Resume Next
Dim r%
Dim Suche As Range
Dim wks As Worksheet
Set wks = Workbooks("HBHMListe.xls").Worksheets("Tabelle1")
'Call Sortieren_CboN3
'HookWheel Me, Me.Width, Me.Height, 3
cboNamen3.Text = cboNamen3.Column(0) & " " & cboNamen3.Column(1)
Set Suche = wks.Range("E:F").Find(cboNamen3.Value, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If (Not Suche Is Nothing) Then '
Code vierte ComboBox:
Private Sub ComboBox35_Change()
On Error Resume Next
TextBox32.Text = Cells(ComboBox35.ListIndex + 3, 1)
cboNamen6.Text = Cells(ComboBox35.ListIndex + 3, 2)
cboNamen5.Text = Cells(ComboBox35.ListIndex + 3, 3)
cboNamen3.Text = Cells(ComboBox35.ListIndex + 3, 5) And Cells(ComboBox35.ListIndex + 3, 6)
End Sub