
SgtDak
|
Salut,
bon alors il me semble qu'il n'existe aucune solution réellement simple à mon problème, j'ai donc coder une fonction qui résoud mon problème, comme certains pourraient être intéressés, je poste ici mon explication :
Tout d'abord, je vérifie que la chaîne de recherche exacte n'est pas dans le texte. Si ce n'est pas le cas, je remplace tous les caractères accentués de la chaîne de recherche et du texte en utilisant des variables temporaires. Ainsi, leur longueur ne change pas. Si je trouve la chaîne non-accentuée dans le texte de base, j'utilise sa position pour remplacer dans mon texte d'origine (avec les accents) les parties correspondantes.
Voici la fonction que j'utilise : ' ========================================== ' Fonction permettant de remplacer des mots dans un texte par ces mots surligné ' strText est le texte dans lequel on cherche ces mots ' arrCrit est un tableau contenant les mots à rechercher Function strReplaceText(strText, arrCrit) ' Déclaration des variables Dim strElem Dim strElem2 Dim strTemp Dim strTemp2 Dim intPos ' Initialisation des variables strTemp = strText ' On parcourt le tableau d'éléments For Each strElem In arrCrit If InStr(1, strTemp, strElem, vbTextCompare) > 0 Then strTemp = Replace(strTemp, strElem, "<SPAN STYLE=""{background-color:#FFFF00}"">" _ & Mid(strTemp, InStr(1, strTemp, strElem, vbTextCompare), Len(strElem)) & "</SPAN>", 1, Len(strTemp), vbTextCompare) Else strTemp2 = strTemp strElem2 = strElem strTemp2 = Replace(strTemp2, "é", "e", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "è", "e", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ê", "e", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ë", "e", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "à", "a", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "â", "a", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ä", "a", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "î", "i", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ï", "i", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ô", "o", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ö", "o", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ù", "u", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "û", "u", 1, Len(strTemp2), vbTextCompare) strTemp2 = Replace(strTemp2, "ü", "u", 1, Len(strTemp2), vbTextCompare) strElem2 = Replace(strElem2, "é", "e", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "è", "e", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ê", "e", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ë", "e", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "à", "a", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "â", "a", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ä", "a", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "î", "i", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ï", "i", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ô", "o", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ö", "o", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ù", "u", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "û", "u", 1, Len(strElem2), vbTextCompare) strElem2 = Replace(strElem2, "ü", "u", 1, Len(strElem2), vbTextCompare) intPos = InStr(1, strTemp2, strElem2, vbTextCompare) If intPos > 0 Then strTemp = Left(strTemp, intPos - 1) & "<SPAN STYLE=""{background-color:#FFFF00}"">" & Mid(strTemp, intPos, Len(strElem)) & "</SPAN>" & Right(strTemp, Len(strTemp) - Len(strElem) - intPos + 1) End If End If Next strReplaceText = strTemp End Function ' ==========================================
|