1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
|
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function ComboAutoComplete(ByRef cboComplete As ComboBox, ByVal KeyAscii As Integer, Optional ByVal bLimitToList As Boolean = False) As Long
Dim lRetVal As Long
Dim sSearch As String
Const CB_ERR = (-1), CB_FINDSTRING = &H14C
On Error GoTo ErrFailed
If cboComplete.Style <> vbComboDropdown Then
Debug.Print "Error in ComboAutoComplete. Combo must be of the style vbComboDropdown..."
Debug.Assert False
'Renvoie KeyAscii
ComboAutoComplete = KeyAscii
Exit Function
End If
If KeyAscii = 8 Then
'Appui sur delete
If cboComplete.SelStart <= 1 Then
cboComplete.Text = ""
ComboAutoComplete = 0
Exit Function
End If
'effacer texte
If cboComplete.SelLength = 0 Then
'effacer un charactere seul
sSearch = UCase$(Left$(cboComplete.Text, Len(cboComplete) - 1))
Else
'effacer la selection
sSearch = Left$(cboComplete.Text, cboComplete.SelStart - 1)
End If
ElseIf KeyAscii < 32 Or KeyAscii > 127 Then
'caractere de clavier invalide
Exit Function
Else
'Ajouter nouveau texte dans le combo
If cboComplete.SelLength = 0 Then
'Ajouter charactere
sSearch = UCase$(cboComplete.Text & Chr$(KeyAscii))
Else
'inserer charactere
sSearch = Left$(cboComplete.Text, cboComplete.SelStart) & Chr$(KeyAscii)
End If
End If
'cherche la valeur la plus proche
lRetVal = SendMessage(cboComplete.hwnd, CB_FINDSTRING, -1, ByVal sSearch)
If lRetVal = CB_ERR Then
'Il ne trouve pas d'élément dans la liste
'renvoyer KeyAscii en fonction du type de liste.
If bLimitToList = True Then
'Bloque KeyAscii
ComboAutoComplete = 0
Else
'Renvoie KeyAscii
ComboAutoComplete = KeyAscii
End If
Else
'trouve un élément dans la liste
cboComplete.ListIndex = lRetVal
cboComplete.SelStart = Len(sSearch)
cboComplete.SelLength = Len(cboComplete.Text) - cboComplete.SelStart
ComboAutoComplete = 0
End If
Exit Function
ErrFailed:
'Return the keycode
ComboAutoComplete = KeyAscii
End Function
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = ComboAutoComplete(ComboBox1, KeyAscii, False)
End Sub
Private Sub UserForm_Initialize()
'Ici on rempli le combo box des données disponibles
Me.ComboBox1.AddItem "A"
Me.ComboBox1.AddItem "AB"
Me.ComboBox1.AddItem "ABC"
Me.ComboBox1.AddItem "ABCD"
Me.ComboBox1.AddItem "BACDE"
Me.ComboBox1.AddItem "BBADEF"
Me.ComboBox1.AddItem "BBCDEFG"
End Sub |
Partager