recherche textbox affichage dans listbox via une autre feuille

[micsel]

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]

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 ()

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]

@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]

Bonjour à tous


ajouter ce code à Private Sub btn_select_Click()

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]

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

 

[Rhysand]

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

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

par ce qui suit

.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

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]

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]

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

 

[micsel]

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