Recherche de texte et MFC

[jipi06]

Bonsoir à toutes et tous

a tous les spécialistes des MFC et de la recherche de texte :
je cherche à mettre en forme une cellule en couleur quand elle contient au moins un des mots contenu dans une autre cellule...

je joins un fichier plus explicite Avant ...Après

Merci beaucoup de votre aide.

Jipi

 

[ROGER2327]

Re : Recherche de texte et MFC

Bonjour jipi06

Je ne sais pas faire cela à coup de mise en forme conditionnelle, mais une procédure événementielle peut résoudre le problème.

À placer dans le module de la feuille concernée :

Option Explicit

Const Tâches = "B8:D12,B21:D25"   'Plage des Tâches
Const Absences = "F8:H12,F21:H25" 'Plage des Absences
Const Dates = 1                   'N° de colonne des dates.

Private Sub Worksheet_Change(ByVal Cible As Range)
Dim i&, j&, tf1 As Boolean, tf2 As Boolean, tmp, ch$, x
Dim oCel As Range, lCel As Range, lPlg As Range, Plg As Range
Dim oDic As New Scripting.Dictionary 'Nécessite le référencement de la bibliothèque Microsoft Scripting Runtime
   Set Plg = Intersect(Cible, Union(Range(Absences), Range(Tâches)))
  If Not Plg Is Nothing Then
    With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
    For Each lCel In Intersect(Plg.Cells, Union(Range(Absences), Range(Tâches))).Rows
      tmp = Intersect(Rows(lCel.Row), Range(Absences)).Value
      oDic.RemoveAll
      For i = 1 To UBound(tmp, 2)
        x = Split(tmp(1, i), "+")
        For j = 0 To UBound(x): oDic(Trim(x(j))) = Trim(x(j)): Next
      Next
      Set lPlg = Intersect(Rows(lCel.Row), Range(Tâches))
      tmp = oDic.Keys
      tf1 = False
      For Each oCel In lPlg.Cells
        tf2 = False
        oCel.Font.Bold = False
        ch = "+" & Trim(oCel.Value) & "+"
        For i = 0 To oDic.Count - 1
          If ch Like "*+" & oDic(tmp(i)) & "+*" Then
            tf2 = True
            oCel.Characters(Start:=InStr(oCel.Value, oDic(tmp(i))), Length:=Len(oDic(tmp(i)))).Font.FontStyle = "Gras"
          End If
        Next
        tf1 = tf1 Or tf2
        If tf2 Then oCel.Interior.ColorIndex = 45 Else oCel.Interior.ColorIndex = xlNone
      Next
      If tf1 Then Cells(lPlg.Row, Dates).Interior.ColorIndex = 3 Else Cells(lPlg.Row, Dates).Interior.ColorIndex = xlNone
    Next
    With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  End If
End Sub

En prime, on a la mise en gras indicative…​

ROGER2327
#5214

Mercredi 18 Clinamen 138 (Les 27 Êtres Issus des Livres Pairs, V)
20 Germinal An CCXIX
2011-W14-6T01:03:23Z

 

[jipi06]

Re : Recherche de texte et MFC

Bonjour

Merci beaucoup Roger
ça répond parfaitement à mon besoin.
A bientôt

jipi

 

[jipi06]

Re : Recherche de texte et MFC

Re bonsoir

Roger2327 j'aurais une question supplémentaire : finalement l'astuce du caractère "gras" m'interresse et je voudrais y rajouter une couleur rouge au texte sélectionné : ca fonctionne pour afficher la couleur mais quand je modifie a nouveau la zone absences le "gras" disparait mais pas la couleur.... y doit y avoir un truc....


oCel.Characters(Start:=InStr(oCel.Value, oDic(tmp(i))), Length:=Len(oDic(tmp(i)))).Font.FontStyle = "Gras"
oCel.Characters(Start:=InStr(oCel.Value, oDic(tmp(i))), Length:=Len(oDic(tmp(i)))).Font.ColorIndex = 3


Merci de ton aide

jipi