VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Leider bietet die in VB integrierte ComboBox nicht den Komfort wie z.B. diejenige aus Access. So werden während der Eingabe keine Vorschläge / Wort-Ergänzungen gemacht. Mit der unten präsentierten Routine "ComboFind" wird dies jedoch leicht ermöglicht.

So sorgt der Code

Private Sub cmbXYZ_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode >= 48 Then ComboFind cmbXYZ
End Sub

dafür, dass bei jedem Tastendruck (Cursor-Tasten u.ä. ausgefiltert) nach einen passenden Text gesucht wird. Die textuelle Suche erfolgt aus Performance-Gründen via API-Routine "SendMessage", die im Deklarationsteil eines Moduls deklariert wird:

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

Die eigentliche Arbeit wird in der folgenden Prozedur gemacht. Zuerst wird der gewünschte Arbeitsmodus bestimmt; Die Routine erlaubt nämlich auch die Suche nach ItemData-Werten, die oft für IDs benutzt werden (s.a. ComboBox mit Daten aus MDB fülllen). Anschließend wird die entsprechende Suche durchgeführt:

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