Klassenmodul änsern
30.12.2015 00:16:56
Thomas
ich habe in einer Userform eine Combobox mit 13 spalten. (gefüllt mit ca.500 Zeilen). In dieser Combobox lässt es sich nicht so toll navigieren ( z.B Mausrad oder so). Nun habe ich den Code unten im Netz gefunden. Durch Ihn wird mir während der Eingabe über tastatur ein wort vorgeschlagen. das funktioniert wie ich es bis jetzt getestet habe gut. Es hat für mich nur ein problem er schlägt mir immer die Wörter aus der Spalte 1 vor. Gern würde ich aber wörter aus der Spalte 3 vorschlagen lassen. Aber ich finde einfach die Stellschraube nicht. Kann jemand helfen?
Gern bin ich auch offen für andere Wege.
schon vor ab vielen dank
Liebe grüsse thomas
https://www.herber.de/bbs/user/102478.xlsm
normales modul
Private Sub cmbXYZ_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode >= 48 Then ComboFind cmbXYZ
End Sub
Klassenmodul
Private Declare Function SendMessageA Lib "user32" ( _
ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C
Public Sub ComboFind( _
ByRef cmb As ComboBox, _
Optional ByVal Value As Variant)
Dim i As Long
Dim ID As Long
Dim Text As String
'Modus bestimmen:
If IsMissing(Value) Then
'Suche nach Combo-Eingabe
Text = LCase$(cmb.Text)
ElseIf IsNull(Value) Then
'Suche nach Null
ID = 0
ElseIf IsNumeric(Value) Then
'Suche nach bestimmter ID
ID = CLng(Value)
Else
'Suche nach bestimmten Text
Text = LCase$("" & Value)
End If
'Vorab checken, ob Index bereits OK:
i = cmb.ListIndex
If i >= 0 Then
If Len(Text) Then
If LCase$(cmb.List(i)) = Text Then Exit Sub
Else
If cmb.ItemData(i) = ID Then Exit Sub
End If
End If
With cmb
If Len(Text) Then
'Nach Text suchen:
i = SendMessageA(.hwnd, CB_FINDSTRING, -1, ByVal Text)
If i >= 0 Then
.ListIndex = i
If IsMissing(Value) Then
'"Angefügten" Text selektieren:
.SelStart = Len(Text)
.SelLength = Len(.Text)
End If
End If
Else
'Nach ID suchen:
For i = 0 To .ListCount - 1
If .ItemData(i) = ID Then
.ListIndex = i
Exit For
End If
Next i
End If 'Len(Text)
End With
End Sub