Discussion :

[ponspons]

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]

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]

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]

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]

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]

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