' dans cette fonction on traite la chaine avant de faire la recherche
' exemple : minuscules, enlevé accent ...
Function traitementChaine(chaine As String) As String
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"
Dim i As Integer
Dim lettre As String * 1
' on passe la chaine en minuscule
chaine = LCase(chaine)
' on enlève tous les accents
For i = 1 To Len(accent)
lettre = Mid$(accent, i, 1)
If InStr(chaine, lettre) > 0 Then
chaine = Replace(chaine, lettre, Mid$(noAccent, i, 1))
End If
Next i
traitementChaine = chaine
End Function
Function rechercheProduit()
' déclarations des variables
Dim rmsgbox As Boolean
Dim chaine As String
Dim resultatRecherche As Range
Dim fournisseur As String
Dim produit As String
Dim ligne As Integer
Dim ligne_sav As Integer
Dim colonne As Integer
Dim colonne_sav As Integer
Dim nombreProduit As Integer
chaine = UserForm9.ComboBox1.Text
nombreProduit = 0
' on vérifie que la chaine n'est pas vide
If chaine = "" Then
Exit Function
End If
' on efface l'éventuelle précédente recherche
Sheets("Feuil7").Activate
Cells.Select
Selection.ClearContents
UserForm9.ListeResultat.RowSource = ""
' on envoi la chaine à la fonction de traitement
chaine = traitementChaine(chaine)
' on se place sur l'onglet données
Sheets("listfrs").Activate
Cells(1, 1).Activate
' et on recherche sur toutes la feuille, sauf la première colonne,
' colonne des fournisseurs
Columns("E:F").Select
Set resultatRecherche = Selection.Find(What:=chaine, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
' si aucun résultat est renvoyé, on affiche une popup
If (resultatRecherche Is Nothing) Then
rmsgbox = MsgBox("Aucun résultat trouvé pour " + Chr(34) + UserForm9.ComboBox1.Text + Chr(34), vbOKOnly + vbExclamation, "Recherche")
Exit Function
End If
Do
resultatRecherche.Activate
ligne_sav = ligne
ligne = ActiveCell.Row
colonne_sav = colonne
colonne = ActiveCell.Column
' si on a terminé la recherche (bas de feuille)
If (ligne_sav > ligne) Then
' on sort de la fonction
Exit Do
End If
If ((ligne_sav = ligne) And colonne_sav >= colonne) Then
Exit Do
End If
' on incrémente le nombre de produits trouvés
nombreProduit = nombreProduit + 1
' on récupère le texte de la première colonne de la cellule trouvée
fournisseur = Cells(ligne, 1).Text
produit = ActiveCell.Text
' on le copie dans la page de résultats
Sheets("Feuil7").Cells(nombreProduit + 1, 1) = fournisseur
Sheets("Feuil7").Cells(nombreProduit + 1, 2) = produit
Set resultatRecherche = Columns("E:F").FindNext(resultatRecherche)
Loop Until resultatRecherche Is Nothing
' on met les titres des colonnes
Sheets("Feuil7").Cells(1, 1) = "Fournisseur"
Sheets("Feuil7").Cells(1, 2) = "Produit"
Cells(1, 1).Select
' on affiche le résultat dans la listbox
Dim source As String
source = Sheets("Feuil7").Name + "!A2:B" + CStr(nombreProduit + 1)
UserForm9.ListeResultat.RowSource = source
' on affiche une popup pour donnée le résultat de la recherche
If (nombreProduit = 1) Then
rmsgbox = MsgBox("Recherche terminée: " + CStr(nombreProduit) + " fournisseur trouvé pour " + Chr(34) + UserForm9.ComboBox1.Text + Chr(34), vbOKOnly + vbInformation, "Recherche terminée")
Else: rmsgbox = MsgBox("Recherche terminée: " + CStr(nombreProduit) + " fournisseurs trouvés pour " + Chr(34) + UserForm9.ComboBox1.Text + Chr(34), vbOKOnly + vbInformation, "Recherche terminée")
End If
End Function
