Private Sub Worksheet_Change(ByVal Target As Range)
' les libellés séparés par un crochet fermant "]"
' Attention ! Les libellés doivent être exactement tels qu'ils doivent apparaitre y compris
' les espaces au début et à la fin de chaque libellé (le cas échéant)
Const libelles = " produit périmé, ] péremption à moins de 30 jours, ] péremption entre 30 et 60 jours et ] stock mini atteint"
Dim x$, tVal, tLib, deb&, i&, n&
If Intersect(Range("r2,s2,t2,k3"), Target) Is Nothing Then Exit Sub 'si aucun stock modifié on quitte la macro
tLib = Split(libelles, "]") ' les libellés sont mis dans un array de base 0 (via un split)
ReDim tVal(0 To UBound(tLib)) ' les valeurs sont aussi mises dans un array tVal de base 0
tVal(0) = [R2]: tVal(1) = [S2] ' on y met les valeurs
tVal(2) = [T2]: tVal(3) = [K3] ' on y met les valeurs
For i = 0 To 3: x = x & tVal(i) & tLib(i): Next ' on construit le texte à afficher
[A1] = x ' on affiche le texte
[A1].Font.ColorIndex = xlColorIndexAutomatic ' on passe tout le texte en couleur automatique
[A1].Font.Bold = False ' tout le texte n'est pas en gras
For i = 0 To 3 ' boucler sur les valeurs et les libellés
n = InStr(1, x, tVal(i), vbTextCompare) ' chercher la position n de la valeur i
With [A1].Characters(Start:=n, Length:=Len(tVal(i))).Font ' avec le texte débutant à n de longueur celle de valeur i
.Color = RGB(255, 0, 0) ' on passe en rouge
.Bold = True ' on passe en gras
End With
' on remplace la valeur et son libellé par des "_" -> pour être certain de trouver la prochaine valeur
' et pas une valeur précédente ou une valeur dans un libellé
x = Replace(x, tVal(i), String(Len(tVal(i)), "_"), 1, 1, vbTextCompare)
x = Replace(x, tLib(i), String(Len(tLib(i)), "_"))
Next i
End Sub
