Test si une MFC est vrai

**ponspons** · 19/05/2010, 16h06

Bonjour,

Après avoir chercher un peu partour sur le forum et avoir essayé un bout de code trouvé sur un autre post, je lance un sos...

J'ai un tableau avec des cellules qui contiennent des mises en forme conditionnelles. Si les cases ne sont pas complétées correctement la cellule est en orange (code 45). J'aimerai savoir si le test est ok ou non.

En gros, je voudrais tester à l'enregistrement du fichier qu'il ne reste aucune cellule orange, c'est à dire cellule obligatoire non remplis.

J'ai testé la fonction evaluate() avec le code suivant trouvé sur le forum mais je n'arrive pas à la faire fonctionner...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Public Sub NbRouge()
Dim Plage As Range
Dim Cel As Range
Dim Compteur As Long
    Set Plage = Range("B4:B7")
    For Each Cel In Plage
        If Cel.FormatConditions.Count > 0 Then
            If MFC(Cel) = 45 Then
                Compteur = Compteur + 1
            End If
        End If
    Next Cel
    'Adapter l'adresse
    Range("A2") = Compteur
End Sub
 
 
Private Function MFC(RG As Range) As Integer
Dim e As Long, i As Byte, Test As Boolean
Dim MFCobj As FormatCondition
 
    For i = 1 To RG.FormatConditions.Count
        Set MFCobj = RG.FormatConditions(i)
        If MFCobj.Type = xlCellValue Then
            Select Case MFCobj.Operator
            Case xlEqual
                Test = RG = Evaluate(MFCobj.Formula1)
            Case xlNotEqual
                Test = RG <> Evaluate(MFCobj.Formula1)
            Case xlGreater
                Test = RG > Evaluate(MFCobj.Formula1)
            Case xlGreaterEqual
                Test = RG >= Evaluate(MFCobj.Formula1)
            Case xlLess
                Test = RG < Evaluate(MFCobj.Formula1)
            Case xlLessEqual
                Test = RG <= Evaluate(MFCobj.Formula1)
            Case xlNotBetween
                Test = (RG < Evaluate(MFCobj.Formula1) Or RG > Evaluate(MFCobj.Formula2))
            Case xlBetween
                Test = (RG >= Evaluate(MFCobj.Formula1)) And (RG <= Evaluate(MFCobj.Formula2))
            End Select
            If Test Then
                MFC = MFCobj.Interior.ColorIndex
                Exit Function
            End If
        End If
    Next i
    MFC = 0
End Function
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
NbRouge
 
End Sub

En fait je ne rentre jamais dans la condition "If MFCobj.Type = xlCellValue Then"
car MFCobj.Type = 1 et xlCellValue = 2

un exemple de mise en forme conditionnelle sur la première cellule testée :
=SI(B4="";VRAI)
Cette cellule est vide donc la condition est vérifiée.

J'espère avoir été suffisamment clair

Merci d'avance pour votre aide.

**laetitia** · 19/05/2010, 18h06

bonjour ponspons le forum pourquoi tu veux tester la couleur ??? Teste directement ta cellule ou ta plage de cellules est renseignée plus simple non!!!!
if plage=""then conditions etc....

**ponspons** · 20/05/2010, 10h26

Bonjour Laetitia,
C'est vrai que l'exemple que j'ai mis n'est pas le meilleure, dans le fichier j'ai des mises en forme différentes suivant les cellules et l'exemple que j'ai donné était le plus simple.
J'en ai d'autres qui donnent des choses plus compliquées et ce serait long de tout retranscrire :
ex : =SI(ET(F14="";$A14="Creation";OU($B$8="SAFRAN - SAFARI";$B$8="SAFRAN - EBAP SAG";$B$8="CEP - E@I EUROPE"));VRAI)

ex2 : =SI(ET(J14="";OU(ET(OU($B$8="SAFRAN - SAFARI";$B$8="SAFRAN - EBAP SAG");OU($A14="Modification of data";$A14="Creation"));ET($A14="Creation";B$8="CEP - E@I EUROPE")));VRAI)

**laetitia** · 20/05/2010, 20h12

re , essai comme cela plage b4:b7 a adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Sub compte()
  Dim c As Range, t As Long
  For Each c In [B4:B7]
    If CouleurMFC(c) = 45 Then
      t = t + 1
    End If: Next c
   MsgBox t 'la tu recupere dans une variable pour l'utiliser
End Sub
Function MFC(champ As Range, coul)
  Application.Volatile
  For Each c In champ
    If MFC(c) = coul Then
      t = t + 1
    End If:  Next c
  MFC = t
End Function

**ponspons** · 21/05/2010, 10h31

Bonjour Laetitia,

Merci pour ton aide mais ça ne fonctionne toujours pas. D'ailleurs je ne comprends pas ton morceau de code, la fonction CouleurMFC n'existe pas et je ne comprends pas comment tu réussi à récupérer la couleur de la case ou le résultat de la MFC...

**laetitia** · 22/05/2010, 09h52

re, pas si simple avec les MFC...
une autre macro adaptée compte les cellules differentes de "blanc" dans une plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
Public x As Byte
Dim c As Range, FC As FormatCondition, F1, F2
Sub es()
x = 0
For Each c In [B4:B7]
c.Activate
 MFC
Next c
MsgBox x 'variable a utiliser
End Sub
 
Sub MFC()
 For Each FC In ActiveCell.FormatConditions
 If FC.Type = xlCellValue Then
      F1 = Evaluate(FC.Formula1)
      Select Case FC.Operator
        Case xlBetween: If ActiveCell >= F1 _
          And ActiveCell <= Evaluate(FC.Formula2) Then Exit For
        Case xlEqual: If ActiveCell = F1 Then Exit For
        Case xlGreater: If ActiveCell > F1 Then Exit For
        Case xlGreaterEqual: If ActiveCell >= F1 Then Exit For
        Case xlLess: If ActiveCell < F1 Then Exit For
        Case xlLessEqual: If ActiveCell <= F1 Then Exit For
        Case xlNotBetween: If ActiveCell < F1 _
          Or ActiveCell > Evaluate(FC.Formula2) Then Exit For
        Case xlNotEqual: If ActiveCell <> F1 Then Exit For
      End Select
    Else
      If Evaluate(FC.Formula1) Then Exit For
    End If
     Next FC
  If Not FC Is Nothing Then x = x + 1
  End Sub

j'ai pas simplifie a voir déja si ca marche pour ton projet

une variante compte les cellules couleur 45 par MFC

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub coul()
Dim c As Range, FC As FormatCondition, F1, x As Long
Application.ScreenUpdating = False
x = 0
For Each c In [a1:B10] 'plage a definir
c.Activate
For Each FC In ActiveCell.FormatConditions
  If FC.Type = xlCellValue Then
    F1 = Evaluate(FC.Formula1)
    Select Case FC.Operator
      Case xlBetween: If ActiveCell >= F1 _
        And ActiveCell <= Evaluate(FC.Formula2) Then Exit For
      Case xlEqual: If ActiveCell = F1 Then Exit For
      Case xlGreater: If ActiveCell > F1 Then Exit For
      Case xlGreaterEqual: If ActiveCell >= F1 Then Exit For
      Case xlLess: If ActiveCell < F1 Then Exit For
      Case xlLessEqual: If ActiveCell <= F1 Then Exit For
      Case xlNotBetween: If ActiveCell < F1 _
        Or ActiveCell > Evaluate(FC.Formula2) Then Exit For
      Case xlNotEqual: If ActiveCell <> F1 Then Exit For
    End Select
  Else
    If Evaluate(FC.Formula1) Then Exit For
  End If
Next FC
If Not FC Is Nothing Then
If FC.Interior.ColorIndex = 45 Then x = x + 1 'index couleur= 45
End If
Next c
MsgBox x 'variable a utiliser
End Sub

**sabzzz** · 22/05/2010, 14h45

bonjour ponspons, laetitia,

une autre solution est d'utiliser une cellule pour vérifier le résultat de la formule de la MFC, pour cette exemple j'ai utilisé la cellule IV1 pour faire le test.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub TestMFC()
Dim c As Range, a As Integer, i As Integer, ad As String, x As String
For Each c In Sheets("Feuil1").Range("B4:B7") '<------ plage à adapter
 c.Select
   ' test de 1 à x (possibilité de 3 formules de MFC)
    For i = 1 To c.FormatConditions.Count
        'récuperer la formule
        x = c.FormatConditions(i).Formula1
        'transcrire la formule en cellule IV1
        Range("IV1").FormulaLocal = x
        'vérifier si le résultat de la formule est vrai
        'si une des trois formules de MFC est vrai, a=1
        If Range("IV1") Then a = 1
    Next
    'si aucune des 3 formules MFC n'est vrai, on récupere l'adresse de la cellule fautive
    If a = 0 Then ad = ad & c.Address & ", "
    'remet le test à 0 pour la prochaine cellule à vérifier
    a = 0
Next
MsgBox "Les cellules suivante retournent FAUX pour la MFC: " & Chr(10) & ad
End Sub

**ponspons** · 28/05/2010, 15h31

Bonjour,

désolé pour la réponse tardive, je viens seulement d'avoir le temps de tester. J'ai finalement utilisé la méthode d'Isabelle qui fonctionne parfaitement !
Merci beaucoup pour votre aide.

Juste un détail que j'ai relevé, dans une de mes condition dans les MFC, j'avais je testais le range A4:G4="" et la formule fonctionnait parfaitement. Par contre quand j'ai copié la formule dans ma case tampon ça m'a mis une erreur. J'ai contourné le problème en testant toutes les case mais ce n'est pas très propre.
Est-ce que vous auriez une idée, pourquoi la formule fonctionne dans un cas et pas dans l'autre ?