Discussion :

[docjo]

Bonjour.
Je souhaiterai mettre automatiquement en surbrillance (en gras ou en couleur) un mot contenu dans une cellule à chaque fois que dans toute feuille on quitte la cellule (sur tout changement d'une valeur de cellule par exemple). Ce mot sera contenu dans une liste de mots stockés dans une colonne.
J'ai essayé d'adapter le code suivant mais je n'y arrive pas:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
 
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, I As Long
    Dim xCell As Range
    Dim xArr
    Dim xArr2
    On Error Resume Next
    xHStr = ' ici je dois mettre la référence à la liste de mot stockés dans une feuille, initialement le code appelait une boite de dialogue
 
    If TypeName(xHStr) <> "String" Then Exit Sub
    Application.ScreenUpdating = False
 
    xArr2 = Split(xHStr, ",") 'initialement décompose les mots entrés dans le boite de dialogue
    For j = 0 To UBound(xArr2)
        xHStr = xArr2(j)
 
        xHStrLen = Len(xHStr)
        For Each xCell In Selection
            xArr = Split(xCell.Value, xHStr)
            xCount = UBound(xArr)
            If xCount > 0 Then
                xStrTmp = ""
                For I = 0 To xCount - 1
                    xStrTmp = xStrTmp & xArr(I)
                    xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                    xStrTmp = xStrTmp & xHStr
                Next
            End If
        Next
    Next
 
    Application.ScreenUpdating = True
End Sub

Merci pour votre aide

[Tête de chat]

Bonjour,

tu as regardé du côte des mises en forme conditionnelles ?



Selectionne la plage de saisie, et crée une MEFC avec une formule du type :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=NB.SI($E$1:$E$5;A1)<>0

où $E$1:$E$5 est ton dictionnaire, A1 la première cellule de la zone de saisie.

[docjo]

Bonjour

Merci pour cette proposition mais en fait c'est bien mettre en surbrillance un mot dans une cellule et non pas toute la cellule . C'est pourquoi j'avais pensé à vba parce qu'avec la MFC je n'ai pas trouvé non plus.



Merci d'avance

[Franc]

Bonjour, voici ma solution, à mettre dans le module de la feuille.
J'utilise la colonne A pour stocker les mots à colorer mais tu peux changer si tu veux.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Cellule As Range
    Dim Liste As Range
    Dim Mot As String
    Dim Pos As Integer
    Dim Mots As Variant
    Dim motListe As Variant
    Dim i As Integer, j As Integer
 
    'Colonne contenant les mots à colorer, changer si besoin
    Set Liste = ThisWorkbook.Sheets("Feuil1").Range("A1", Range("A1").End(xlDown))
 
    'Boucle sur les cellules modifiées
    For Each Cellule In Target
        'Ignore les modifications dans la colonne A, changer si colonne Liste modifiée
        If Cellule.Column <> 1 Then
            'Divise le contenu de la cellule en mots
            Mots = Split(Cellule.Value, " ")
 
            'Boucle sur les mots de la cellule
            For i = 0 To UBound(Mots)
 
                'Récupère le mot courant
                Mot = Mots(i)
 
                'Compare le mot courant avec les mots de la liste
                For Each motListe In Liste
                    'Si le mot courant correspond à un mot de la liste
                    If Mot = motListe.Value Then
 
                        'Récupère la position du dernier caractère du mot
                        Pos = InStrRev(Cellule.Value, Mot)
 
                        'Si le mot est trouvé, colorie les caractères du mot
                        If Pos <> 0 Then
                            Cellule.Characters(Start:=Pos, Length:=Len(Mot)).Font.Color = RGB(255, 0, 0)
                        End If
 
                    End If
                Next motListe
 
            Next i
 
        End If
 
    Next Cellule
 
End Sub

[docjo]

C'est exactement cela. Grand merci !!!