Textbox et listbox

Bonjour,

Pouvez vous m'aider à solutionner mon petit problème de Listbox et Texbox, car la je ne sais pas vraiment trouver la solution... Merci d'avance.

Tout est dit dans mon fichier joint.

Merci à tous pour votre aide !

Bonsoir Weider, bonsoir le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Private Sub TextBox1_Change()
Dim TV As Variant

TV = Range(Range("A17"), Range("C" & Application.Rows.Count).End(xlUp))
With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "25;75;75"
End With
Range("C5:C7").ClearContents
If Len(TextBox1) > 0 Then
  For I = 1 To UBound(TV, 1)
    If InStr(1, TV(I, 2), TextBox1.Value) <> 0 Then
        With ListBox1
            .AddItem
            .Column(0, .ListCount - 1) = TV(I, 1)
            .Column(1, .ListCount - 1) = TV(I, 2)
            .Column(2, .ListCount - 1) = TV(I, 3)
        End With
    End If
  Next I
End If
Range("C5:C7").Value = Me.ListBox1.ListCount
End Sub

Plutôt que de lire directement dans les cellules, utilise une variable tableau de type variant. Cela va beaucoup plus vite et sur les gros tableaux on voit de suite la différence...

Bonsoir ThauThème et merci pour ton retour,

Je ne vois ta pièce jointe !?

Ceci dit, dans mon fichier envoyé, j'ai fais un copier coller avec ton code modifié, mais au final lorsque je tape ma référence recherchée, et bien par exemple 31221-VP7- ,après VP7- tout s'efface !?

Autrement dit, au bout du 10ème digit tout disparait !?

J'ai besoin de la référence entière car pour certaines, seule les trois derniers digits changent...

Merci pour ton aide.

Re,

Désolé j'ai oublié la pièce jointe hier... La voici maintenant.

Le code fonctionne mais ce sont tes références qui sont mal foutues ... Plus sérieusement, il y a un espace avant le dernier tiret et tu as dû oublier de le taper. C'est pour cela que ça s'est vidé... La fonction INSTR renvoie la position du texte de la TextBox1 dans la référence. Tape l'espace et tu verras que ça fonctionne...

Bonjour ThauThème !

Tu as tout à fait raison !!! J'avais oublié ce foutu espace. Effectivement ça fonctionne ensuite.

--->Deux derniers points...

- Je n'arrive pas à caler l'espace nécessaire à ma 'Référence' dans la deuxième boite pour la voir dans son entièreté, je mets '120 pt' dans les propriétés, je sauvegarde ensuite, mais lors d'une réouverture du fichier, je retrouve '75 pt' !?!?

- Les ligne trouvées lors d'une recherche s'affichent bien dans ma deuxième box, OK, mais dans mon tableau au dessous mes colonnes 'Onglet', 'Référence' et 'Désignation' ne sont pas verte !?!?

J'aurais souhaité que ça me les verdissent au fur et à mesure de ma recherche...

Merci pour ton aide !!!

Thautheme,

J'ai réussi à solutionner ce point !

..."- Je n'arrive pas à caler l'espace nécessaire à ma 'Référence' dans la deuxième boite pour la voir dans son entièreté, je mets '120 pt' dans les propriétés, je sauvegarde ensuite, mais lors d'une réouverture du fichier, je retrouve '75 pt' !?!?"...

Par contre reste ce point important pour lequel je n'arrive à rien...

..."- Les ligne trouvées lors d'une recherche s'affichent bien dans ma deuxième box, OK, mais dans mon tableau au dessous mes colonnes 'Onglet', 'Référence' et 'Désignation' ne sont pas verte !?!?

J'aurais souhaité que ça me les verdissent au fur et à mesure de ma recherche..."...

Voici mon fichier.

Re,

Le code modifié (tu choisiras la couleur) :

Private Sub TextBox1_Change()
Dim TV As Variant
Dim LI As Integer

Cells.Interior.ColorIndex = xlNone
TV = Range(Range("A17"), Range("C" & Application.Rows.Count).End(xlUp))
With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50;150;150"
End With
Range("C5:C7").ClearContents
If Len(TextBox1) > 0 Then
  For I = 1 To UBound(TV, 1)
    If InStr(1, TV(I, 2), TextBox1.Text, vbTextCompare) <> 0 Then
        With ListBox1
            .AddItem
            .Column(0, .ListCount - 1) = TV(I, 1)
            .Column(1, .ListCount - 1) = TV(I, 2)
            .Column(2, .ListCount - 1) = TV(I, 3)
        End With
        LI = Columns(1).Find(TV(I, 1), , xlValues, xlWhole).Row
        Cells(LI, 1).Resize(1, 18).Interior.ColorIndex = 4 'couleur à redéfinir si besoin
    End If
  Next I
End If
Range("C5:C7").Value = Me.ListBox1.ListCount
End Sub

Juste un mot.... PARFAIT

Mille merci pour toute ton aide !

Excellente fin de journée à toi.

Oup's.... J'ai parlé un poil trop vite...

En re-testant ce soir chez moi, bein... ça me sélectionne des fois les ou la bonne ligne, mais des fois ça part en vrille et me sélectionne des ligne qui n'ont rien à voir avec ce que j'ai tapé dans ma zone de recherche !?!?!?

Re,

En effet il y avait deux erreurs dans le code, désolé. Le voici corrigé (à nouveau) :

Private Sub TextBox1_Change()
Dim TV As Variant
Dim LI As Integer

Cells.Interior.ColorIndex = xlNone
TV = Range(Range("A17"), Range("C" & Application.Rows.Count).End(xlUp))
With ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50;150;150"
End With
Range("C5:C7").ClearContents
If Len(TextBox1) > 0 Then
  For I = 1 To UBound(TV, 1)
    If InStr(1, TV(I, 2), TextBox1.Text, vbTextCompare) <> 0 Then
        With ListBox1
            .AddItem
            .Column(0, .ListCount - 1) = TV(I, 1)
            .Column(1, .ListCount - 1) = TV(I, 2)
            .Column(2, .ListCount - 1) = TV(I, 3)
        End With
        LI = I+16
        Cells(LI, 1).Resize(1, 18).Interior.ColorIndex = 4 'couleur à redéfinir si besoin
    End If
  Next I
End If
Range("C5:C7").Value = Me.ListBox1.ListCount
End Sub

Je ne te l'avais pas signalé de manière explicite mais tu n'es pas obligé de taper une référence depuis le début. Si, par exemple, tu tapes 222, tu n'auras que la référence 31222-VP7-0001 qui sera sélectionnée... Il suffit que le texte que tu tapes soit contenu dans la référence pour que sa ligne soit sélectionnée.

Tu n'as pas à être désolé Thautheme ! tu me rends un sacré service en m'aidant de la sorte et c'est très sympa !

Ta correction est efficace, je viens de tester et ça m'a l'air top.

Pour parfaire mon fichier, je vais me débrouiller à chercher comment faire pour mettre juste à coté de ma boite de recherche un 'bouton' ou autre contrôle (sympa) qui me permettrais d'effacer son contenu. Ça serai plus pratique et rapide que de sélectionner à la souris puis effacer......

Mille mercis à toi encore une fois.

Re,

Ce code te permet de vider la TextBox en cliquant sur n'importe quelle cellule du tableau :

Private Sub TextBox1_LostFocus()
TextBox1.Value = ""
Me.TextBox1.Activate
End Sub

Bonjour Thautheme,

Merci pour ton code, très efficace... Trop même

Effectivement, je ne peux plus modifier mes autres cellules sur mon document( cellules avec texte par exemple...). Ça ne me laisse plus la main pour changer des textes ou autres

Ça me créé même un bug général lorsque je veux fermer mon fichier, obligé de passer par un pti 'Ctrl Alt Sup'

J'ai mis ton code à la suite du précédent, j'ai bon ?

Private Sub TextBox1_Change()

Dim TV As Variant

Dim LI As Integer

Cells.Interior.ColorIndex = xlNone

TV = Range(Range("A17"), Range("C" & Application.Rows.Count).End(xlUp))

With ListBox1

.Clear

.ColumnCount = 3

.ColumnWidths = "50;150;150"

End With

Range("C5:C7").ClearContents

If Len(TextBox1) > 0 Then

For I = 1 To UBound(TV, 1)

If InStr(1, TV(I, 2), TextBox1.Text, vbTextCompare) <> 0 Then

With ListBox1

.AddItem

.Column(0, .ListCount - 1) = TV(I, 1)

.Column(1, .ListCount - 1) = TV(I, 2)

.Column(2, .ListCount - 1) = TV(I, 3)

End With

LI = I + 16

Cells(LI, 1).Resize(1, 10).Interior.ColorIndex = 4 'couleur à redéfinir si besoin

End If

Next I

End If

Range("C5:C7").Value = Me.ListBox1.ListCount

End Sub

Private Sub TextBox1_LostFocus()

TextBox1.Value = ""

Me.TextBox1.Activate

End Sub

Re,

Arf !. Je n'avais pas remarqué ce détail qui n'en est pas un car, fermer avec [Ctrl]+[Alt]+[Suppr.], c'est carrément insupportable. Une alternative (plutôt une bidouille en fait) avec ce code :

Private Sub TextBox1_LostFocus()
TextBox1.Value = ""
If ActiveCell.Row > 3 Then Me.TextBox1.Activate
End Sub

• Quand tu veux vider la TextBox1, tu cliques sur n'importe quelle cellule en dessous de la ligne 3

• Quand tu veux fermer, tu cliques sur n'importe cellule de la ligne 2

À rajouter en fin comme tu l'as fait c'est parfait.

Ok, merci Thautheme,

Perso, ça me va , le gros souci c'est que mon fichier est utilisé par moult personnes et que beaucoup de ces personnes ne ferment jamais les fichiers Excel en passant par 'Menu' puis 'Fermer', mais cliquent directement sur l'étoile en haut à droite de l'interface Excel, et là... bein ça bug à nouveau

Re,

Comprend pas ! Pas de bug chez moi ni à la fermeture du fichier en cliquant sur la croix du fichier, ni à la fermeture d'Excel en cliquant sur la crois rouge...

Quel est le message et/ou quelle est la ligne de code surlignée de jaune quand ça plante ?

En faite, lorsque tu ferme la boite de recherche en cliquant n'importe ou sur la ligne 2, là tu peux ensuite fermer Excel via la croix, aucun problème... MAIS... si tu vide simplement la cellule de recherche en cliquant n'importe ou en dessous de la ligne 3, et que tu clic sur la croix pour fermer Excel, et bien c'est là que le bug intervient !

En faite, ça dépends ou tu clic juste avant !

Pas de boite d'alerte, rien, seulement ton curseur de souris qui clignote comme un fou Et à partir de la tu n'as plus la main

Re,

Comme je te disais, je n'ai pas ce bug chez moi. Par conséquent je ne peux pas t'aider sur ce coup là...

Bonjour Thautheme,

Moi ça me le fait sur le PC de mon boulot et le mien perso .

Pas grave, je te remercie encore pour toute ton aide et te souhaite un excellent weekend (pluvieux chez moi, Orléans).

Re,

Merci. Bon WE à toi aussi malgré ce temps de pucelle...