XL 2013 Compter couleurs MFC (mise en forme conditionnelle)

apnart · 26 Octobre 2017

Bonjour,

J'utilise depuis longtemps une fonction (probablement issue d'ici) qui compte les cellules de couleur en fonction d'une cellule de référence, et ça fonctionne très bien
Voici le code :

Code:

Function CompteCouleurFond(Zne As Range, CaseRef As Range) As Integer

Dim CouleurInterieure As String

    Application.Volatile True
    CompteCouleurFond = 0
    CouleurInterieure = CaseRef.Interior.ColorIndex

    For Each cell In Zne
       If cell.Interior.ColorIndex = CouleurInterieure Then CompteCouleurFond = CompteCouleurFond + 1
    Next cell

End Function

Je voudrais maintenant compter les couleurs de cellules dont la couleur a été changée par une mise en forme conditionnelle.

J'ai trouvé sur le net le code suivant permettant de trouver la valeur de la couleur MFC, ça fonctionne, mais je n'arrive pas à utiliser cela pour l'intégrer dans ma 1ère fonction.

Code:

Public Function CouleurMFC(RG As Range, Optional Mode As Byte = 0) As Variant
Dim e As Long, i As Byte, LoTest As Boolean
Dim LoMFC As FormatCondition
    Application.Volatile
    'boucle sur le nombre de condition(s)
   'Si pas de MFC .FormatConditions.Count renvoi 0
   For i = 1 To RG.FormatConditions.Count
        Set LoMFC = RG.FormatConditions(i)
        If LoMFC.Type = xlCellValue Then
        'tester le type de la formule entrée
           Select Case LoMFC.Operator
            Case xlEqual
                LoTest = RG = Evaluate(LoMFC.Formula1)
            Case xlNotEqual
                LoTest = RG <> Evaluate(LoMFC.Formula1)
            Case xlGreater
                LoTest = RG > Evaluate(LoMFC.Formula1)
            Case xlGreaterEqual
                LoTest = RG >= Evaluate(LoMFC.Formula1)
            Case xlLess
                LoTest = RG < Evaluate(LoMFC.Formula1)
            Case xlLessEqual
                LoTest = RG <= Evaluate(LoMFC.Formula1)
            Case xlNotBetween
                LoTest = (RG < Evaluate(LoMFC.Formula1) Or RG > Evaluate(LoMFC.Formula2))
            Case xlBetween
                LoTest = (RG >= Evaluate(LoMFC.Formula1)) And (RG <= Evaluate(LoMFC.Formula2))
            End Select
            If LoTest Then
                'Peu ajouter d'autre format si nécessaire,
               'comme la bordure, la police etc..
               Select Case Mode
                Case 0
                    CouleurMFC = LoMFC.Interior.ColorIndex
                Case 1
                    CouleurMFC = LoMFC.Interior.Color
                End Select
                Exit Function
            End If
        End If
    Next i
    CouleurMFC = xlNone
End Function

Si vous aviez le p'tit coup de pouce qui va bien pour dénouer mon soucis, ça serait super !

Merci d'avance,
Bruno.

CISCO · 26 Octobre 2017

Bonjour

Il me semble que ROGER2327 avait fait quelque chose sur ce forum au sujet du comptage des cellules coloriées à l'aide d'une MFC. A toi de chercher avec son pseudo.

@ plus

chris · 26 Octobre 2017

Bonjour à tous

On peut le faire avec la propriété DisplayFormat de la cellule mais seulement en procédure, pas en fonction personnalisée (va comprendre Charles !)

Il faut donc ruser pour l'activer lors d'un calcul ou autre évènement.

apnart · 26 Octobre 2017

Merci à vous 🙂

CISCO, j'ai effectivement retrouvé le fil suivant de 2014, mais bon :-( c'est pas vraiment satisfaisant... Peut-être que d'autres ont eu d'autres idées depuis ?
https://www.excel-downloads.com/thr...ec-une-mfc-comment-faire.225356/#post-1430809

J'avais également trouvé des infos chez l'excellent Boisgontier : http://boisgontierjacques.free.fr/pages_site/mfc.htm#comptemfc

mais ça marche pô dans mon cas

VIARD · 26 Octobre 2017

apnart à dit:
Merci à vous 🙂

CISCO, j'ai effectivement retrouvé le fil suivant de 2014, mais bon :-( c'est pas vraiment satisfaisant... Peut-être que d'autres ont eu d'autres idées depuis ?
https://www.excel-downloads.com/thr...ec-une-mfc-comment-faire.225356/#post-1430809

J'avais également trouvé des infos chez l'excellent Boisgontier : http://boisgontierjacques.free.fr/pages_site/mfc.htm#comptemfc

mais ça marche pô dans mon cas

Bonjour Apnart, Cisco et à tous

Je ne sais si le fichier joins pourra t'aider.
Dedans tu trouveras une fonction de "Laurent Longre" qui justement récupère l'index couleur.
Ce fichier teste l'état d'une cellule.
A toi d'adapter.

cordialement

Jean-Paul

apnart · 26 Octobre 2017

😱 qu'est-ce que ?

VIARD · 26 Octobre 2017

apnart à dit:
😱 qu'est-ce que ?

ReBonjour

il semble que tu n'ais pas regardé.
voici la fonction

'===================================
'---------- Couleur MFC ------------
'===================================
'=====================================
Sub Elle_Est_Belle_Ma_MEFC(RetourMFC, RetourMfcHexa)
'Laurent Longre, MPFE, corrections 2003
Dim FC As FormatCondition, F1, F2
Dim c As Range, Hexa

Set c = Cells.Find(Empty)
Application.ScreenUpdating = False
For Each FC In ActiveCell.FormatConditions
c.FormulaLocal = FC.Formula1: F1 = c
If FC.Type = xlCellValue Then
Select Case FC.Operator
Case xlBetween, xlNotBetween:
c.FormulaLocal = FC.Formula2: F2 = c
If FC.Operator = xlBetween Then If ActiveCell >= F1 _
And ActiveCell <= F2 Then Exit For
If ActiveCell < F1 Or ActiveCell > F2 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 xlNotEqual: If ActiveCell <> F1 Then Exit For
End Select
Else
If F1 Then Exit For
End If
Next FC
If Not FC Is Nothing Then
RetourMFC = FC.Interior.ColorIndex
Hexa = FC.Interior.Color
RetourMfcHexa = "&H" & Hex$(Hexa)
' MsgBox RetourMfcHexa
Else
RetourMFC = ActiveCell.Interior.ColorIndex
End If
c.Clear
End Sub
'=====================================
j'ai juste ajouté la valeur Hexa.

A+ Jean-Paul

apnart · 26 Octobre 2017

ça ressemble un peu à la f

VIARD à dit:
ReBonjour

il semble que tu n'ais pas regardé.
voici la fonction

'===================================
'---------- Couleur MFC ------------
'===================================
'=====================================
Sub Elle_Est_Belle_Ma_MEFC(RetourMFC, RetourMfcHexa)
'Laurent Longre, MPFE, corrections 2003
Dim FC As FormatCondition, F1, F2
Dim c As Range, Hexa

Set c = Cells.Find(Empty)
Application.ScreenUpdating = False
For Each FC In ActiveCell.FormatConditions
c.FormulaLocal = FC.Formula1: F1 = c
If FC.Type = xlCellValue Then
Select Case FC.Operator
Case xlBetween, xlNotBetween:
c.FormulaLocal = FC.Formula2: F2 = c
If FC.Operator = xlBetween Then If ActiveCell >= F1 _
And ActiveCell <= F2 Then Exit For
If ActiveCell < F1 Or ActiveCell > F2 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 xlNotEqual: If ActiveCell <> F1 Then Exit For
End Select
Else
If F1 Then Exit For
End If
Next FC
If Not FC Is Nothing Then
RetourMFC = FC.Interior.ColorIndex
Hexa = FC.Interior.Color
RetourMfcHexa = "&H" & Hex$(Hexa)
' MsgBox RetourMfcHexa
Else
RetourMFC = ActiveCell.Interior.ColorIndex
End If
c.Clear
End Sub
'=====================================
j'ai juste ajouté la valeur Hexa.

A+ Jean-Paul

Ca ressemble à la fonction que j'avais mis plus haut (pas le même code, mais pour ce que j'en comprendre (donc pas tout) c'est sur la même trame, sauf que là c'est un "sub" pas une "function"

c'est donc pas tout simple mon affaire à ce que je vois :-(

chris · 26 Octobre 2017

Super je suis devenue transparente

Sans doute Halloween...

job75 · 26 Octobre 2017

Bonsoir à tous,

Oui comme l'a dit chris à partir d'Excel 2007 on peut utiliser DisplayFormat.

On peut par exemple placer cette macro dans ThisWorkbook :

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim coul&, c As Range, n
Cancel = True
coul = Target.DisplayFormat.Interior.Color
For Each c In Sh.UsedRange
  If c.DisplayFormat.Interior.Color = coul Then n = n + 1
Next
MsgBox n & " cellules ont cette couleur dans la plage " & Sh.UsedRange.Address(0, 0)
End Sub

Double-clic sur une cellule quelconque.

La macro compte les cellules dont la couleur de fond est la même que celle de la cellule sélectionnée, que la couleur soit appliquée manuellement ou par MFC.

A+

mapomme · 26 Octobre 2017

Bonsoir chris 🙂,

chris à dit:
Super je suis devenue transparente

Sans doute Halloween...

Mais non, mais non... La preuve, j'ai essayé de l'utiliser le displayformat. L’inconvénient est qu'un changement de format (MFC ou non) ne produit aucun évènement.

edit : bonsoir job75 - me suis fait grillé sur ce coup ! 😉

job75 · 26 Octobre 2017

Re, salut mapomme,

Avant d'aller dormir une petite précision, assez évidente.

Ma macro du post #10 permet de compter les cellules colorées par MFC si les couleurs appliquées par MFC sont différentes de celles appliquées manuellement.

Il vaut mieux que ce soit le cas, autrement ce serait un joyeux foutoir.

Une cellule pourrait avoir la même couleur appliquée 2 fois, manuellement et par MFC !

A+

apnart · 27 Octobre 2017

Merci à vous 3, et non Chris, tu n'es pas transparente, je ne savais juste pas comment "gérer" ta proposition :-(

La proposition de la pomme fonctionne très bien, en effet, ça compte les cellules avec les MFC, mais je ne sais pas l'exploiter, car dans son exemple, il y a 3 MFC, j'aurais aimé avoir la possibilité de compter les 3 MFC distinctement...

Vous avez raison, décidément, c'est un boulet l'Bruno :-(

chris · 27 Octobre 2017

Bonjour

Compter les couleurs différentes ou les règles différentes ?

apnart · 27 Octobre 2017

Compter couleurs associées des règles

dans l'exemple donné par la pomme, il a mis 3 règles, j'aimerais compter combien il y en a pour chaque couleur et non pas un total

Effectuez une recherche sur Excel Downloads...

XL 2013 Compter couleurs MFC (mise en forme conditionnelle)

apnart

XLDnaute Occasionnel

CISCO

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

apnart

XLDnaute Occasionnel

VIARD

XLDnaute Impliqué

Pièces jointes

apnart

XLDnaute Occasionnel

VIARD

XLDnaute Impliqué

apnart

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

apnart

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

apnart

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée