Autocomplete Textbox ou Combobox ActiveX

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je cherche à créer une liste d'autocomplétion sur un control ActiveX Textbox ou Combobox.

L'idée, c'est que l'on commence à saisir, une liste apparais sous le control et s'affine automatiquement au fil de la saisie.

Je suis parti dans l'idée d'une Textbox avec un menu CommandBar Popup.
Ca fonctionne à ceci prêt qu'a l'affichage le Popup est modal et bloque l'avancement de la saisie dans la Textbox.

Code:

1
2
3
Private Sub txtRepere_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    popup txtRepere
End Sub

Code:

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
Function getAutocompleteValues(search As String) As String()
    Dim row As Range
 
    Dim values(7) As String
    Dim nbValues As Integer
 
    For Each row In Range("_456")
        If UCase(Left(row(0, 4), Len(search))) = UCase(search) Then
            values(nbValues) = row(0, 4) & " - " & row(0, 5)
            nbValues = nbValues + 1
        End If
 
        If nbValues > 7 Then Exit For
    Next
 
    getAutocompleteValues = values
End Function
 
Sub popup(control As Variant)
    Dim Barre As CommandBar
    Dim sheet As Worksheet
    Dim txtRepere As OLEObject
 
    Set sheet = ActiveSheet
    Set txtRepere = sheet.OLEObjects("txtRepere")
 
    On Error Resume Next
    CommandBars("autoComplete").Delete
 
    Set Barre = CommandBars.Add("autoComplete", msoBarPopup, False, True)
 
    For Each Value In getAutocompleteValues(txtRepere.Object.Value)
        With Barre.Controls.Add(msoControlButton, , , , True)
            .Caption = Value
            '.FaceId = 326
            .OnAction = "autoCompleteChoice"
        End With
    Next
 
    Dim PosX As Single, PosY As Single
    PosX = control.Left - 15
    PosY = control.Top + control.Height + 15 + Barre.Height
    Application.CommandBars("autoComplete").ShowPopup PosX, PosY
End Sub

Sinon l'idée est la et ça fonctionne comme je le souhaite, alors déjà, y a t'il un moyen de ne pas rendre le Popup modal ?

Sinon idée numéro 2, utiliser une Combobox et vider et remplir la liste au fur et a mesure de la saisie.
Mais alors la c'est la cata !
Déjà parce que quand on saisi la Combobox présélectionne une valeur et ça malgré le passage de AutoWordSelect à False
Et ensuite parce que le vidage et le remplissage produise un affichage bizarre de la liste, même en faisant un Dropdown avant vidage et après remplissage pour le rafraîchir.
Pièce jointe 203132

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'ComboBox1.Clear
 
    ComboBox1.DropDown
 
    Do While ComboBox1.ListCount > 0
        ComboBox1.RemoveItem (0)
    Loop
 
    For Each Value In getAutocompleteValues(ComboBox1.Value)
        ComboBox1.AddItem Value
    Next
 
    ComboBox1.DropDown
End Sub

Qu'en pensez vous ?

Merci :)

07/03/2016, 18h56
cerede2000

1 pièce(s) jointe(s)

J'ai trouvé quelque chose de similaire mais avec des formules, ce qui est plutôt pas mal :)
Pièce jointe 203172

Adaptable en VBA uniquement ?

PS : Suite passage en XLSM ce système fonctionne assez mal en plus :(
07/03/2016, 19h41
patricktoulon

1 pièce(s) jointe(s)

re

bonsoir
il me semble que l'auto complétion est en natif dans la combo ou listbox

Pièce jointe 203178
07/03/2016, 20h22
cerede2000

En fait c'est de l'autocomplétion avec recherche que je veut mettre en place.

Plus on saisi plus la liste est restreinte pour n'afficher que les résultat qui sont susceptibles de correspondre.

Un search as you type en fait

1 pièce(s) jointe(s)

dans ce cas la c'est encore plus simple

il te faut une variable tableau pour la source (plage de cellules)
et voila un exemple avec une liste box pour que tu vois bien les choix se restreindre jusqu'à arriver au bon item

prends un fichier vierge met lui un textbox et une listebox

dans le module met ceci et arrange ta plage en fonction de tes données
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub TextBox1_Change() With Sheets(1) tablo = .Range("A1:A7").Value ' la source des données complete .ListBox1.Clear For i = 1 To UBound(tablo) If InStr(tablo(i, 1), .TextBox1) > 0 Then Sheets(1).ListBox1.Object.AddItem tablo(i, 1) End If Next End With End Sub
et voila le tour est joué
Pièce jointe 203189

08/03/2016, 01h48
boisgontierjacques

2 pièce(s) jointe(s)

Bonjour,

Qq exemples avec vraie saisie intuiive type Google

Pour en savoir plus faire une recherche sur Google avec : recherche intuitive combobox

Boisgontier
08/03/2016, 12h04
cerede2000

Super !

Merci à vous deux, j'ai commencé un truc avec une textbox et une listbox qui sert de conteneur.
Je vais quand même essayer avec la combobox, qui fera moins de code au final :)

Ah si ! Dernière subtilité :)

Est il possible d'utiliser une combobox avec plusieurs colonnes ?

La 1ere colonne de recherche et une seconde avec un libellé de description.

Autre point bizarre.

Si je créer une combobox depuis la GUI Excel en la dessinant, la propriété .List est accessible correctement.

Par contre, si je créer ma combobox en VBA :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub showCombobox(Target As Range)
        Dim sheet As Worksheet: Set sheet = ActiveSheet
        Dim ComboBox As OLEObject
 
        On Error Resume Next
        Set ComboBox = sheet.OLEObjects("cmbRepere")
        If ComboBox Is Nothing Then
            Set ComboBox = sheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=0, Top:=0, Width:=120, Height:=30)
            ComboBox.name = "cmbRepere"
 
            ComboBox.Object.ColumnCount = 3
            ComboBox.Object.ColumnWidths = "0;50;150"
            ComboBox.Object.ListWidth = 250
            ComboBox.Object.MatchEntry = 2
        End If
 
        ComboBox.Left = Target.Left
        ComboBox.Top = Target.Top + Target.Height
 
        ComboBox.Object.Clear
        ComboBox.Visible = True
        ComboBox.Activate
End Sub

Alors l'accès a la propriété .List me renvoi une erreur 70 permission denied :(

Avez vous uns idée ?

bonjour jacques
ta 1ere proposition est quasi identique a celle ci sauf que je n'utilise pas de de dico et je boucle sur un tableau pas une plage
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub TextBox1_Change() With Sheets(1) tablo = .Range("A1:A7").Value ' la source des données complete .ListBox1.Clear For i = 1 To UBound(tablo) If InStr(tablo(i, 1), .TextBox1) > 0 Then Sheets(1).ListBox1.Object.AddItem tablo(i, 1) End If Next End With
par contre la 2 eme ne fait que tronquer la liste a partir de l'élément sélectionné

1 pièce(s) jointe(s)

Bonjour,

ComboBox 2 colonnes avec saisie intuitive
La liste affichée dans le combobox se réduit au fur et à mesure de la frappe des caractères.

Code:

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
 
Dim choix1()
Private Sub UserForm_Initialize()
  choix1 = [liste].Value
  Me.ComboBox1.List = choix1
  If Val(Application.Version) > 10 Then SendKeys "{F4}"
End Sub
 
Private Sub ComboBox1_Change()
   If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, Application.Index(choix1, , 1), 0)) Then
     Dim b()
     Me.TextBox1 = ""
     tmp = UCase(Me.ComboBox1) & "*"
     n = 0
     For i = LBound(choix1) To UBound(choix1)
       If UCase(choix1(i, 1)) Like tmp Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = choix1(i, 1): b(2, n) = choix1(i, 2)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n + 1)
        Me.ComboBox1.List = Application.Transpose(b)
        Me.ComboBox1.RemoveItem n
      End If
      Me.ComboBox1.DropDown
    Else
      On Error Resume Next
      Me.TextBox1 = Me.ComboBox1.Column(1)
    End If
End Sub
 
Private Sub CommandButton1_Click()
 If Me.TextBox1 <> "" Then
    ActiveCell = UCase(Me.ComboBox1)
    ActiveCell.Offset(0, 1) = Me.TextBox1
    Unload Me
 End If
End Sub

Boisgontier

09/03/2016, 10h53
cerede2000

Super !!

Merci beaucoup :)
09/03/2016, 11h11
patricktoulon

1 pièce(s) jointe(s)

re

Bonjour jacques
il manque un clear en cas de non occurrence ici "ravo" donne la même chose que "rav"
Pièce jointe 203378