recherche textbox affichage dans listbox via une autre feuille

micsel · 29 Novembre 2020

Bonjour a toutes et tous.

Afin d'aider mon épouse dans la rédaction de ses factures (A.E)
j'ai crée un petit fichier de facturation avec une base client elle peut en ajouter etc...
je voudrais également qu'elle puisse faire une recherche, et là ... badaboum, impossible pour moi
l'idée est qu'elle tape dans la recherche pour voir si le client est existant, soit un nom, prenom mail ou autre et cela s'affiche

pour plus de précision, je vous joins la feuille excel.

Par avance, merci pour vos réponses

Rhysand · 29 Novembre 2020

Bonsoir à tous,

juste une idée, vous pouvez adapter et ajouter plus de recherche, il suffit de suivre l'exemple

dans la listbox j'ai ajouté 3 colonnes, la première colonne apparaît l'adresse de la plage où les données ont été trouvées, la deuxième colonne est le code client, la troisième colonne est le résultat de la recherche

placez le code suivant dans votre formulaire utilisateur où se trouve Private Sub T_recherche_Change ()

VB:

Private Sub T_recherche_Change()

If Me.T_recherche.Text = "" Then Exit Sub

Dim rRow As Range
Dim SearchTerm As String
Dim x As Integer

SearchTerm = VBA.LCase("*" & T_recherche.Text & "*")

With Me.ListBox
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50 pt;50 pt;50 pt"
    For Each rRow In Range(Application.ThisWorkbook.Worksheets("clients").Cells(1, 1), Application.ThisWorkbook.Worksheets("clients").Cells(Rows.Count, 2).End(xlUp)).Resize(, 15).Rows
        If VBA.LCase(VBA.CStr(rRow.Range("C2"))) Like SearchTerm Then         ' Prénom
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("C2").Address(False, False)         ' to get range address
                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 2) = rRow.Range("C2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("D2"))) Like SearchTerm Then     ' Nom
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("D2").Address(False, False)         ' to get range address
                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 2) = rRow.Range("D2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("J2"))) Like SearchTerm Then     ' Téléphone
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("J2").Address(False, False)         ' to get range address
                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 2) = rRow.Range("J2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("K2"))) Like SearchTerm Then     ' Email
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("K2").Address(False, False)          ' to get range address
                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 2) = rRow.Range("K2")
        End If
    Next rRow
    .ForeColor = &H404040
End With

End Sub

micsel · 30 Novembre 2020

@Rhysand
c'est génial, c'est exactement ce que je voulais

Dis moi, serait ce trop te demander un petit truc en plus.
si je selectionne la "ligne" qui m'interresse, j'avais créée un bouton "selectionner" qui enverrait en cellule m2 le code client

Par avance merci

Rhysand · 30 Novembre 2020

Bonjour à tous

ajouter ce code à Private Sub btn_select_Click()

VB:

Private Sub btn_select_Click()

If Me.ListBox.ListCount = 0 Then Exit Sub

Dim x As Long
Dim xCount As Integer
Dim idClient As String
Dim sht As Worksheet

xCount = 0

For x = 0 To Me.ListBox.ListCount - 1
    If Me.ListBox.Selected(x) Then xCount = xCount + 1
    If xCount > 1 Then MsgBox "Une seule ligne de la liste peut être sélectionnée!", vbExclamation, "Information!": Exit Sub
Next x

If xCount = 0 Then MsgBox "Aucune donnée n'a été sélectionnée dans la liste!", vbExclamation, "Information!": Exit Sub

idClient = Me.ListBox.List(Me.ListBox.ListIndex, 1)
Debug.Print idClient

Set sht = Application.ThisWorkbook.Worksheets("Fact")

Application.ScreenUpdating = False
sht.Range("M2").Value = idClient
Application.ScreenUpdating = True

If Not sht Is Nothing Then Set sht = Nothing

End Sub

micsel · 30 Novembre 2020

ah zut, ca ne marche pas
je sais pourquoi, en fait il copie le "C0002" alors que la base fichier est juste 2 ..

Rhysand · 30 Novembre 2020

Bon après-midi à tous

Je n'ai pas bien compris votre dernier message

vous avez une mise en forme personnalisée dans la plage ("M2") de la feuille ("Fact") et dans la colonne ("A") de la feuille ("client"), est-ce exact?

et vous ne voulez pas le texte de mise en forme, juste le nombre ajouté?

si c'est le cas, changez-le simplement dans la macro

VB:

.List(.ListCount - 1, 1) = rRow.Range("A2").Text

par ce qui suit

VB:

.List(.ListCount - 1, 1) = rRow.Range("A2")

faire de même pour les autres options

ainsi, le code client dans la listbox sera par exemple: 2 au lieu de C0002
et lors du transfert vers la plage ("M2"), il ne transférera que le nombre, par exemple 2, et le formatage de la plage fera le reste

c'est ce qui cause votre réaction amusante du Post 5?

ou alors, je l'ai déjà fait, c'est de remplacer le code par celui-ci

VB:

Private Sub T_recherche_Change()

If Me.T_recherche.Text = "" Then Exit Sub

Dim rRow As Range
Dim SearchTerm As String
Dim x As Integer

SearchTerm = VBA.LCase("*" & T_recherche.Text & "*")

With Me.ListBox
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50 pt;50 pt;50 pt"
    For Each rRow In Range(Application.ThisWorkbook.Worksheets("clients").Cells(1, 1), Application.ThisWorkbook.Worksheets("clients").Cells(Rows.Count, 2).End(xlUp)).Resize(, 15).Rows
        If VBA.LCase(VBA.CStr(rRow.Range("C2"))) Like SearchTerm Then         ' Prénom
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("C2").Address(False, False)         ' to get range address
'                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 1) = rRow.Range("A2")
                .List(.ListCount - 1, 2) = rRow.Range("C2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("D2"))) Like SearchTerm Then     ' Nom
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("D2").Address(False, False)         ' to get range address
'                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 1) = rRow.Range("A2")
                .List(.ListCount - 1, 2) = rRow.Range("D2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("J2"))) Like SearchTerm Then     ' Téléphone
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("J2").Address(False, False)         ' to get range address
'                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 1) = rRow.Range("A2")
                .List(.ListCount - 1, 2) = rRow.Range("J2")
        ElseIf VBA.LCase(VBA.CStr(rRow.Range("K2"))) Like SearchTerm Then     ' Email
                .AddItem ""
                .List(.ListCount - 1, 0) = rRow.Range("K2").Address(False, False)          ' to get range address
'                .List(.ListCount - 1, 1) = rRow.Range("A2").Text
                .List(.ListCount - 1, 1) = rRow.Range("A2")
                .List(.ListCount - 1, 2) = rRow.Range("K2")
        End If
    Next rRow
    .ForeColor = &H404040
End With

End Sub

micsel · 1 Décembre 2020

Salut @Rhysand
Super
ca fonctionne nickel.
Merci a toi
(mon épouse m'a demandé si tu avais des enfants pour envoyer un doudou, ou c'est ce qu'elle commercialise)

Rhysand · 1 Décembre 2020

merci beaucoup, oui j'ai un fils, et qui sait, peut-être que je vais acheter un doudou

micsel · 1 Décembre 2020

Rhysand à dit:
merci beaucoup, oui j'ai un fils, et qui sait, peut-être que je vais acheter un doudou

Dans ce cas appelez avant
elle vend aussi de magnifique jouets en bois

recherche textbox affichage dans listbox via une autre feuille

micsel

XLDnaute Junior

Pièces jointes

Rhysand

XLDnaute Junior

micsel

XLDnaute Junior

Rhysand

XLDnaute Junior

micsel

XLDnaute Junior

Rhysand

XLDnaute Junior

micsel

XLDnaute Junior

Rhysand

XLDnaute Junior

micsel

XLDnaute Junior

Discussions similaires