XL 2016 MFC COULEURS

mcj1997

XLDnaute Impliqué
Bonjour,

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

Fichiers joints

mcj1997

XLDnaute Impliqué
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+
 

Fichiers joints

mcj1997

XLDnaute Impliqué
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.
 

Fichiers joints

mcj1997

XLDnaute Impliqué
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,
 

mcj1997

XLDnaute Impliqué
Bonsoir,

Je suis en train de tester la macro dans mon fichier définitif. Deux questions j’ai plusieurs cellules avec des atteintes en % qui sont concernées par la formule donc à mettre sur la ligne : set plage [c3,d3,g14,r2] etc .... les cellules ne se suivent pas et il y en a beaucoup à mettre dans la formule.
1) - à la place de la fonction set plage .... n’existerait il pas une fonction pour dire que toutes les cellules avec un % sont concernées par la mise en forme ?
2) - les cellules qui comportent un % résultent d’une formule qui tournent à l’ouverture du fichier et j’ai constaté que la mise en forme ne se faisait qu’en retapant le résultant sur au moins une cellule et tout se met à jour, c’est bien sûr pas fonctionnel car cela efface la formule, y aurait il une solution de contournement ?

Merci d’avance
 

job75

XLDnaute Barbatruc
Bonjour mcj1997, le forum,

Dans ce fichier (3) les cellules du UsedRange au format pourcentage sont traitées :
Code:
For Each cible In UsedRange
    If Right(cible.NumberFormat, 1) = "%" Then 'format pourcentage
A+
 

Fichiers joints

mcj1997

XLDnaute Impliqué
Bonjour,

Merci pour le retour, toutefois , lorsque j'utilise cette formule dans mon fichier : un premier message : erreur d'éxécution 13 incompatibilité de type et lorsque je clique sur débogage la ligne : If cible < PCT(crit(1))(0) Then ressort en jaune.

Est-ce parce qu'i y a beaucoup de formules, des colonnes masquées ?
 

Discussions similaires


Haut Bas