Extraire Couleur MFC VBA

[djstroubi]

Bonjour,

Je suis bloque depuis plusieurs jours maintenant lorsque je cherche a extraire les couleurs issues d'une MFC. Je realise une MFC sur une colonne, et je cherche a prendre cette couleur pour colorer une forme par la suite (une carte par exemple). Cependant, la difficulte c'est que mon code VBA ne fonctionne pas. J'ai utilise la fonction .FormatCondition mais un message d'erreur m'indique que l'objet ne supporte pas la methode ou la propriete.

Voici mon code

With Sheets("Data")
        For Each c In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
                ShapeName = c.Value
                rang = c.Row
                Debug.Print rang
                color = .Cells(rang, 5).FormatCondition.Interior.ColorIndex
                Sheets("Map").Shapes(ShapeName).Fill.ForeColor.SchemeColor = color

Avez vous des idees??

Merci d'avance

 

[Pierrot93]

Re : Extraire Couleur MFC VBA

Bonjour,

Il faut effectuer par le code les mêmes tests que ceux effectués par la MFC pour la détermination de la couleur..

bonne journée
@+

 

[djstroubi]

Re : Extraire Couleur MFC VBA

Merci Pierrot,

c'est ce que je viens de faire, suite a ton commentaire. Cepedant je ne vois pas a quelle moment je recupere la couleur MFC pour colorer mes formes. Voici le code

With Sheets("Data")
        For Each c In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
            ShapeName = c.Value
            rang = c.Row
        
            Range("E1:E1000").FormatConditions.AddColorScale ColorScaleType:=3
            Range("E1:E1000").FormatConditions(Range("E1:E1000").FormatConditions.Count).SetFirstPriority
            
            Cells(rang, 5).FormatConditions(1).ColorScaleCriteria(1).Type = _
            xlConditionValueLowestValue
                    With Range("E1:E1000").FormatConditions(1).ColorScaleCriteria(1).FormatColor
                        .color = 7039480
                        .TintAndShade = 0
                    End With
                    
            Cells(rang, 5).FormatConditions(1).ColorScaleCriteria(2).Type = _
            xlConditionValueNumber
            Range("E1:E1000").FormatConditions(1).ColorScaleCriteria(2).Value = 0
                    With Range("E1:E1000").FormatConditions(1).ColorScaleCriteria(2).FormatColor
                        .color = 8711167
                        .TintAndShade = 0
                    End With
            Cells(rang, 5).FormatConditions(1).ColorScaleCriteria(3).Type = _
            xlConditionValueHighestValue
                    With Range("E1:E1000").FormatConditions(1).ColorScaleCriteria(3).FormatColor
                        .color = 8109667
                        .TintAndShade = 0
                    End With
                    
                
        Next c

Merci d'avance

 

[Pierrot93]

Re : Extraire Couleur MFC VBA

Re,

c'est ce que je viens de faire, suite a ton commentaire

bah.. c'est pas ce que je vois avec ton code... A priori là tu rajoutes des MFC... tu ne testes pas les cellules pour savoir si elles répondent ou pas à certains critères... ou alors j'ai pas tout compris, fort possible du reste....

 

[djstroubi]

Re : Extraire Couleur MFC VBA

Re,

Je pensais qu'il fallait lance la MFC par VBA pour connaitre par la suite la couleur qui sera appliquee a la cellule pour par la suite associer cette couleur a une forme correspondante. Tu penses que ca ne peut marcher de cette facon. je suis ouvert a toute amelioration

Merci d'avance

 

[Pierrot93]

Re : Extraire Couleur MFC VBA

Re,

Tu penses que ca ne peut marcher de cette facon. je suis ouvert a toute amelioration

bah perso qu'Excel 2003... A voir si avec 2010 d'autres possibilités existent...

 

[djstroubi]

Re : Extraire Couleur MFC VBA

C'est surtout aussi pour pouvoir garder le degrade de couleurs tres visuel.

 

[djstroubi]

Re : Extraire Couleur MFC VBA

Pierrot,
je te reviens, puisque j'ai modifie le script en testant comme tu me l'avait la MFC. Chose etrange, lorsque au'il y a un degrade il ne reconnait pas la couleur alors que lorsqu'il n'y en a pas pas de soucis. Je ne vois pas d'ou peux venir le probleme.

Je te met mon code pour que ce soit plus explicite

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
    For i = 1 To RG.FormatConditions.Count
        Set LoMFC = RG.FormatConditions(i) ' A partir de ce point, la fonction ne fonctionne
        If LoMFC.Type = xlCellValue Then
        
            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
                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 = 0
End Function

et ensuite la requete faisant appel a la fonction.

Sub Colorier()
Dim f As Integer
Dim c As Range
Dim ShapeName As String
Dim rang As String

Application.ScreenUpdating = False

'on remet tous les départements en blanc
For f = 1 To ActiveSheet.Shapes.Count
    Sheets("Map").Shapes(f).Fill.ForeColor.RGB = RGB(255, 255, 255)
    Sheets("Map").Shapes(f).Line.ForeColor.RGB = RGB(166, 166, 166)
    
Next f

    With Sheets("Data")
        For Each c In .Range("B2:B" & .Range("C65536").End(xlUp).Row)
            ShapeName = c.Value
            rang = c.Row
            .Cells(rang, 5).Interior.color = CouleurMFC(Range("E" & rang), 1)
            Sheets("Map").Shapes(ShapeName).Fill.ForeColor = CouleurMFC(Range("E" & rang), 1)
        Next c
    End With
End Sub

merci d'avance pour votre aide

 

[Pierrot93]

Re : Extraire Couleur MFC VBA

Bonjour,

comme déjà dit pas 2010 à dispo, pourrais pas t'aider plus sur cette question.... par contre si tu veux que d'autres puissent t'aider, mets peut être un fichier en PJ avec données de départ et résultat attendu, plus facile que d'essayer de décrypter un code...

bonne journée
@+

 

[Paritec]

Re : Extraire Couleur MFC VBA

Bonjour Pierrot djistroubi le forum
pourquoi se compliquer? tu vires ta MFC, et tu fais ta mise en forme par macro, et là tu auras des couleurs et plus de problèmes pour les récupérer.
a+
papou

 

[djstroubi]

Re : Extraire Couleur MFC VBA

Bonjour Paritec, Pierrot, le forum,

J'ai suivi tes conseils Paritec. J'ai supprime la MFC en realisant la mise en forme par macro. C'est plus simple.

Merci pour vos commentaires.