Highlighting de mots clés trouvés dans un texte

Commenter

Contenu du snippet

Ce code permet de créer un paragraphe à partir d'une recherche de mots clés dans un texte.
Le paragraphe constitué a une taille que l'on peut définir et les mots clés qui y sont contenus sont surlignés.

Source / Exemple : 


' remplace le mot clé dans le texte
function ereg_replace(tx,rg,ch)
   set regEx = New RegExp
   regEx.IgnoreCase = True
   regEx.Global = True
   regEx.Pattern = rg
   ereg_replace = regEx.replace(tx,ch)
end function

' fonction principale
Function GetWrappingText(strSearchText, strKeywords, intLength)
  'déclaration des variables
  Dim tmpText
  Dim tmpKeywords
  Dim intKeywordPos
  Dim intLimit
  Dim strBefore
  Dim strAfter
  tmpText= strSearchText
  tmpKeywords= strKeywords
	intLimit= intLength
	

  Dim aryKeywords
  aryKeywords = Split(tmpKeywords," ", 100) 'space delimiter
  'test si il ya un mot clé dans le texte
  intKeywordPos = instr(lcase(tmpText),lcase(aryKeywords(0)))
 
  Dim intLength1
  If intKeywordPos <> 0 Then 'found a keyword
    'extrait le texte situé avant le mot clé
    strBefore = Left(tmpText, intKeywordPos-1) 

    If Len(strBefore) > intLimit Then
      intLength1 = Len(strBefore) - intLimit
      strBefore = Right(strBefore, intLimit)

    End If
    intLength1 = intKeywordPos + Len(aryKeywords(0)) '.ToString.Length
   
    Dim intLength2
    intLength2 = Len(tmpText)
    strAfter = Right(tmpText, Len(tmpText)-intLength1+1)

    If Len(strAfter) > intLimit Then
      intLength1 = Len(strAfter) - intLimit
      strAfter = Left(strAfter, intLimit)

    End If
    tmpText = strBefore & aryKeywords(0) & strAfter 'tostring

    Dim j
    'Test chaque mot clé pour savoir si il est dans le texte
    j=0
    Do While j <= UBound(aryKeywords)
      If (Len(trim(aryKeywords(j))) > 0) Then	'tostring
        'Remplacement du mot clé grâce à une expression régulière
        Dim input, replacement
        input = tmpText
        replacement= "<span style=""background-color: yellow;"">" + aryKeywords(j) & "</span>"
        tmpText = ereg_replace(input, aryKeywords(j), replacement)
      End If
      j = j + 1
    Loop
    tmpText = "..." & tmpText
  End If
  GetWrappingText= tmpText
End Function

Conclusion :


Le paragraphe constitué n'est pas forcément celui contenant le plus de mots clés, il est construit autour du premier mot clé trouvé dans le texte. Mais c'est une amélioration possible si des gens sont motivés!

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.