XL 2016 MFC COULEURS

mcj1997

XLDnaute Accro
Bonjour,

J'ai une problématique de MFC en PJ.
 

Pièces jointes

  • MFC.xlsx
    11 KB · Affichages: 33

mcj1997

XLDnaute Accro
OK merci mais je recherche une solution permettant de changer les % dans le tableau et non dans la MFC car dans mon tableau officiel je vais avoir plusieurs cases concernées par ces conditions et ce sera plus facile de modifier les conditions dans le tableau et que la MFC aille y chercher les conditions.
 

job75

XLDnaute Barbatruc
Bonjour mcj1997, riton00, Denis132,

La solution de Denis est la bonne solution mais on peut aussi s'amuser avec cette fonction VBA :
Code:
Function PCT(t$)
Dim s, a(), i%, j%
s = Split(" " & t, "%")
ReDim a(UBound(s)) 'base 0
For i = 0 To UBound(s)
    For j = Len(s(i)) - 1 To 1 Step -1
        If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For
    Next
Next
PCT = a 'vecteur ligne
End Function
Fichier joint.

A+
 

Pièces jointes

  • MFC(1).xlsm
    24.5 KB · Affichages: 23

mcj1997

XLDnaute Accro
Bonjour mcj1997, riton00, Denis132,

La solution de Denis est la bonne solution mais on peut aussi s'amuser avec cette fonction VBA :
Code:
Function PCT(t$)
Dim s, a(), i%, j%
s = Split(" " & t, "%")
ReDim a(UBound(s)) 'base 0
For i = 0 To UBound(s)
    For j = Len(s(i)) - 1 To 1 Step -1
        If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For
    Next
Next
PCT = a 'vecteur ligne
End Function
Fichier joint.

A+

Merci, mais j'aimerais bien comprendre car c'est plutôt bien.
 

job75

XLDnaute Barbatruc
Bonjour mcj1997, le forum,

Avec ces macros dans le fichier joint il n'y a plus besoin de MFC :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cible As Range, crit As Range
Set cible = [B2]
Set crit = [D2:D4]
If Intersect(Target, Union(cible, crit)) Is Nothing Then Exit Sub
Target.Select
cible.Interior.ColorIndex = xlNone 'RAZ
cible.Font.ColorIndex = xlAutomatic 'RAZ
If cible < PCT(crit(1))(0) Then
    cible.Interior.ColorIndex = 3 'rouge
    cible.Font.ColorIndex = 2 'police blanche
ElseIf cible >= PCT(crit(2))(0) And cible <= PCT(crit(2))(1) Then
    cible.Interior.ColorIndex = 44 'orange
ElseIf cible >= PCT(crit(3))(0) Then
    cible.Interior.ColorIndex = 43 'vert
End If
End Sub

Function PCT(t$)
Dim s, a(), i%, j%
s = Split(" " & t, "%")
ReDim a(UBound(s)) 'base 0
For i = 0 To UBound(s)
    For j = Len(s(i)) - 1 To 1 Step -1
        If Not IsNumeric(Mid(s(i), j, 1)) Then a(i) = Val(Mid(s(i), j + 1)) / 100: Exit For
    Next
Next
PCT = a 'vecteur ligne
End Function
Noter qu'ici il n'est plus nécessaire que la fonction VBA soit dans un module standard.

Bonne journée.
 

Pièces jointes

  • Sans MFC(1).xlsm
    25.4 KB · Affichages: 16

mcj1997

XLDnaute Accro
Bonjour,

C'est très bien, merci par contre dans mon fichier complet j'ai besoin de faire cette mise en forme dans d'autres cases que B2. Pour rajouter des cases, par exemple pour l'avoir aussi en C2, j'ai essayé cela :
Set cible = [B2;C2]

mais cela ne fonctionne pas,

Merci d'avance,
 

Statistiques des forums

Discussions
311 711
Messages
2 081 782
Membres
101 817
dernier inscrit
carvajal