Sub Macro1()
Dim PL As Range 'déclare la variable PL (PLage)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
'couleur grise pour les "r"
Set PL = Selection 'définit la plage PL (la sélection)
Set R = PL.Find("r", , xlValues, xlWhole) 'définit la recherche R (recherche "r" dans la sélection)
If Not R Is Nothing Then 'condition : s'il existe au moins une occurrence trouvée
PA = R.Address 'définit l'adresse PA de la première occurrence
Do 'exécute
With R.Offset(1, 0).Resize(8, 1).Interior 'prend en compte l'intérieur de la cellule en dessous de l'occurrence trouvée redimensionnée à 8 lignes
.Pattern = xlSolid 'carastériqtique couleurs grise
.PatternColorIndex = xlAutomatic 'carastériqtique couleurs grise
.ThemeColor = xlThemeColorDark1 'carastériqtique couleurs grise
.TintAndShade = -0.249977111117893 'carastériqtique couleurs grise
.PatternTintAndShade = 0 'carastériqtique couleurs grise
End With 'fin de la prise en compte...
Set R = PL.FindNext(R) 'recherche l'occurrence suivante
Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il y a des occurrence ailleurs qu'en PA
End If 'fin de la condition
Set R = Nothing: PA = "" 'vide la variable R, vide la variable PA
'couleur bleue pour les "f"
Set R = PL.Find("f", , xlValues, xlWhole)
If Not R Is Nothing Then
PA = R.Address
Do
With R.Offset(1, 0).Resize(8, 1).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Set R = PL.FindNext(R)
Loop While Not R Is Nothing And R.Address <> PA
End If
Set R = Nothing: PA = ""
'couleur jaune pour les "CA"
Set R = PL.Find("CA", , xlValues, xlWhole)
If Not R Is Nothing Then
PA = R.Address
Do
With R.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Set R = PL.FindNext(R)
Loop While Not R Is Nothing And R.Address <> PA
End If
Set R = Nothing: PA = ""
'couleur violette pour les "RTT"
Set R = PL.Find("RTT", , xlValues, xlWhole)
If Not R Is Nothing Then
PA = R.Address
Do
With R.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Set R = PL.FindNext(R)
Loop While Not R Is Nothing And R.Address <> PA
End If
Set R = Nothing: PA = ""
'couleur ??? pour les "CET"
Set R = PL.Find("RTT", , xlValues, xlWhole)
If Not R Is Nothing Then
PA = R.Address
Do
With R.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Set R = PL.FindNext(R)
Loop While Not R Is Nothing And R.Address <> PA
End If
Set R = Nothing: PA = ""
End Sub