Recherche de texte et MFC

jipi06

XLDnaute Junior
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
 

Pièces jointes

  • Testabsences.xls
    19.5 KB · Affichages: 48

ROGER2327

XLDnaute Barbatruc
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 :
VB:
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
 
Dernière édition:

jipi06

XLDnaute Junior
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
 

Pièces jointes

  • Testabsences2.xls
    34.5 KB · Affichages: 37

Discussions similaires

  • Question
XL pour MAC MFC
Réponses
5
Affichages
681

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib