Rechercher un info se trouvant n'importe où dans le champ sous ACCESS

Question

Bonjour, Je suis à la recherche d'un bout de code qui me premetrais de faire une rechercche dans une table en VBA. Description : j'ai un textbox , je saisie un mots clef et sa vas me chercher dans ma table le mots à n'importe quel endroit sans respecter la casse et qui me renvois cette valeur sous forme de msgbox par exemple j'ai deja fait un truc qui n'est pas assez precis : voici le code : Private Sub Recherche_AfterUpdate() '############################################################################### '## Recherche suivant le N° UDM ou S/N saisie dans la zone de recherche du formulaire '############################################################################### Dim DBRecherche As DAO.Database, RSRecherche As DAO.Recordset Dim otree As TreeView, NodeRechercher() As String, Node As Nodes Dim DBTempRecherche As Database, RSTempRecherche As Recordset ' ouverture de la table Composants en lecture seule. Set DBRecherche = CurrentDb Set RSRecherche = DBRecherche.OpenRecordset("Composants Requ", dbOpenDynaset, dbReadOnly) 'on verifie si un caractère * est saisie dans la zone de recherche Dim Boucle As Integer, limite As Single etoile = 1 If IsNull(Recherche) = True Then Exit Sub For Boucle = 1 To Len(Recherche) If Mid(Recherche, Boucle, Boucle + 1) = "*" Then etoile = 0 If Len(Recherche) * 10 > 90 Then limite = 90 Else limite = Len(Recherche) * 10 End If 'on appel la procedure qui recherche les caracteres corespondant au lettre avant le * Else limite = 90 End If Next 'on cherche le 1er enregistrement correspondant au critere de recherche RSRecherche.FindFirst "numudm='" & Recherche & "'" Dim Result As Integer Dim Compt As Integer Dim OnEnregistre As Integer Compt = 0 Result = 0 OnEnregistre = 0 If RSRecherche("numudm").Value <> Recherche Then RSRecherche.FindFirst "SerialNumber='" & Recherche & "'" If RSRecherche.NoMatch = True Then RSRecherche.MoveFirst 'ouverture de la table tbtemprecherche Set DBTempRecherche = CurrentDb Set RSTempRecherche = DBTempRecherche.OpenRecordset("tbtemprecherche", dbOpenDynaset) 'on regarde si la table est pleine; si oui on la vide. If RSTempRecherche.RecordCount <> 0 Then RSTempRecherche.MoveFirst Do Until RSTempRecherche.EOF RSTempRecherche.Delete RSTempRecherche.MoveNext Loop End If 'recherche des correspondances sur le numéro UDM avec 2 caractéres d'écart Do Until RSRecherche.EOF If CompareText(RSRecherche("numudm").Value, Recherche.Text, limite) = False Then 'recherche des correspondances sur le numéro de série avec 2 caractéres d'écart If IsNull(RSRecherche("serialnumber").Value) = False Then If CompareText(RSRecherche("serialnumber").Value, Recherche.Text, limite) = False Then OnEnregistre = 2 Else OnEnregistre = 1 End If Else OnEnregistre = 2 End If Else OnEnregistre = 1 End If If OnEnregistre = 1 Then 'on inscrit l'enregistrement correspondant dans la table RSTempRecherche.AddNew RSTempRecherche![Pointage] = RSRecherche("pointage").Value RSTempRecherche![NumeroUdm] = RSRecherche("numudm").Value RSTempRecherche![Numerodeserie] = RSRecherche("Serialnumber").Value RSTempRecherche![iddossier] = RSRecherche("ID_DOSSIER").Value RSTempRecherche.Update Compt = Compt + 1 End If RSRecherche.MoveNext Loop End If End If If OnEnregistre = 0 Then Set otree = Me!Xtree.Object Dim i For i = 1 To otree.Nodes.Count If otree.Nodes.Item(i) RSRecherche("numudm").Value Then otree.SelectedItem otree.Nodes.Item(i) Next i DoCmd.RunMacro "atteindretree" Else If Compt = 0 Then MsgBox "Aucun éléments trouvés", , "Erreur" End If Dim Resulta If Compt <> 0 Then If etoile = 1 Then Resulta = MsgBox("Aucun éléments trouvés" & Chr(10) & "Mais un ou plusieurs éléments y ressemblent" & Chr(10) & "voulez-vous les afficher ?", vbYesNo, "Resultat") If Resulta = 6 Then DoCmd.OpenForm "frmproporech", acNormal Else DoCmd.OpenForm "frmproporech", acNormal End If End If RSRecherche.Close End Sub je voudrais un truc du genre la recherche Access avec la fonction n'importe où dans le champs Merci de me renseigner si y'aurais pas moyen de faire appel a la fonction implémenté dans ACCESS ou si y a pas moyen d'utiliser une autre fonction. @+

cs_ultimafight · Answer

re lut voici le reste du code :p Public Function CompareText(String1 As String, String2 As String, limite As Single) As Boolean Dim Compteur As Integer Dim i As Integer Dim Taille As Integer Compteur = 0 i = 1 Do While Len(String1) <> (i - 1) And Len(String2) <> (i - 1) If InStr(Mid(String1, i, 1), Mid(String2, i, 1)) 1 Then Compteur Compteur + 1 i = i + 1 Loop If Len(String1) > Len(String2) Then Taille = Len(String2) Else Taille = Len(String1) End If If etoile = 0 Then If Compteur <> 0 Then If Compteur = Taille - 1 Then CompareText = True End If End If Else If (Compteur / Taille) * 100 >= limite Then 'If Compteur = Taille - 1 Then CompareText = True Else CompareText = False End If End If End Function

cs_Jack · Answer

Salut
(je n'ai pas lu ton code)
Et pourquoi ne pas demander &#224; SQL de faire cette recherche :
Select * From maTable Where monChamp Like '%toto%'
qui se traduit en chainage VB :
RequeteSQL = "Select * From maTable Where monChamp Like '%t" & monTextBox.Text & "%'"
De m&#233;moire, SQL ne tient pas compte de la casse dans les recherches de ce type.

Vala
Jack, MVP VB
NB : Je ne r&#233;pondrai pas aux messages priv&#233;s 

Le savoir est la seule mati&#232;re qui s'accroit quand on la partage. (Socrate)

Rechercher un info se trouvant n'importe où dans le champ sous ACCESS

2 réponses

Discussions similaires