Macro changemet decouleur d'un objet

[Antidox]

Bonjour,

je souhaite faire évoluer la couleur de remplissage de certains objets en fonction des résultats d'un tableau.
- Si la valeur est positive --> l'objet est d'une couleur
- Si la valeur est négative --> l'objet est d'une autre couleur

J'ai trouvé un exemple de macro sur excel-downloads que j'essaye d'appliquer à mon fichier mais malheureusement impossible de la faire fonctionner. C'est pour cela que je viens vous demander votre aide.

Voici le fichier dépouillé des informations confidentielles. Le tableau est normalement remplit automatiquement à partir d'une BD qui se trouve sur une autre feuille. Dans l'exemple j'ai mis des valeurs factices.

Le problème avec cette macro, c'est qu'à chaque changement dans la zone D4 : D15 il y a changement de couleur. Ce qui marche dans cet exemple. Le problème est que dans mon véritable fichier, les cellules sont des liens vers un autre tableau. Il me semble donc que la macro ne prenne pas en compte le changement de valeur dans la cellule.

Merci d'avance pour votre aide et vos possibles propositions d'amélioration.

Cdt,
Antidox

 

[Minick]

Re : Macro changemet decouleur d'un objet

Salut,

Ou se situe ton probleme??
A priori chez moi ca fonctionne, si colonne F>0 jaune sinon 0

 

[Antidox]

Re : Macro changemet decouleur d'un objet

Bonjour Minick,

Le problème avec cette macro, c'est qu'à chaque changement dans la zone D4 : D15 il y a changement de couleur. Ce qui marche dans cet exemple. Le problème est que dans mon véritable fichier, les cellules sont des liens vers un autre tableau. Il me semble donc que la macro ne prenne pas en compte le changement de valeur dans la cellule.

Merci pour ton aide,
Antidox.

 

[Minick]

Re : Macro changemet decouleur d'un objet

Re,

Au temps pour moi, j'ai lu un peu vite.
Dans ce cas c'est dans la feuille ou se situe les données sources qu'il faut declencher
la coloration des formes.

Soit sur Worksheet_calculate soit sur Worksheet_change avec un code un peu modifie:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim L As Byte
    
    With Sheets("PAYS")
        For L = 4 To 15
            If .Cells(L, 6) > 0 Then
                .Shapes(.Cells(L, 3).Value).Fill.ForeColor.SchemeColor = 13
            Else
                .Shapes(.Cells(L, 3).Value).Fill.ForeColor.SchemeColor = 65
            End If
        Next L
    End With
End Sub

Tu peux remettre le test sur la cellule modifie comme dans ton code initial (intersect),
je ne l'ai pas fait ici ne sachant pas comment sont les données sources.

 

[Antidox]

Re : Macro changemet decouleur d'un objet

Merci Minick,

c'est vraiment sympa de prendre du temps pour m'aider à résoudre mon problème.
Cela ne fait pas très longtemps que j'utilise excel et je ne connais rien en vba ... (mais ca va venir).

Je n'ai pas réussi à mettre en œuvre ta solution. Mais je pense que mon problème est peut être un peu plus compliqué que ce que j'expliquais.

Pour être plus précis, je poste un autre fichier complet.

Dans la feuille "Pays", il y a sur la droite 4 listes déroulantes qui permettent de sélectionner des critères :
Pays / Année / mois / période a étudier

Cette sélection permet de rechercher des informations dans la feuille "Pays (Données)". Ces informations sont ensuite rassemblées dans un tableau en haut de la feuille (toujours sur la feuille "Pays (Données)") qui permet de présenter les données et calculer des évolutions (en valeur et en unités).

On retrouve le même tableau sur la feuille "Pays" qui est alimenté par des liens depuis la feuille "Pays (Données)".

Et donc ce que je souhaite, c'est trouver un moyen de changer la couleur des objets en fonction des valeurs qui se trouve dans la colonne F du tableau sur la feuille "Pays". (Evol.% valeur)

Si l'évolution est positive, l'objet sera vert.
Si l'évolution est négative, l'objet sera en rouge.

J'espère que c'est plus clair comme cela.

Encore une fois merci beaucoup pour ton aide.

Antidox.

 

[Minick]

Re : Macro changemet decouleur d'un objet

Re,

Le probleme venait simplement au fait que le controle de l'evolution
etait errone.
On controlait la colonne E (.Cells(L, 5)) au lieu de F (.Cells(L, 6)).
Ci dessous la correction et le declenchement changeait.
Je l'ai mi sur Calculate de la feuille Pays, qui me semble plus adapte.

Option Explicit

Private Sub Worksheet_Calculate()
    Dim L As Byte
    Dim Couleur As Long
    
    With Sheets("PAYS")
        For L = 4 To 15
            If .Cells(L, 6).Value > 0 Then
                Couleur = 11
            Else
                Couleur = 10
            End If
            On Error Resume Next
                .Shapes(.Cells(L, 3).Value).Fill.ForeColor.SchemeColor = Couleur
            On Error GoTo 0
        Next L
    End With
End Sub

J'ai ajoute egalement 'On error Resume next' avant la coloration au cas ou
l'objet n'existe pas comme dans le fichier que tu as joint.
Tu peux le supprimer (ainsi que 'On error Goto 0') si les objets existent tjrs.

 

[Antidox]

Re : Macro changemet decouleur d'un objet

Mille merci Minick,

maintenant j'ai bien mes objets qui changent en fonction des valeurs de la colonne 6 (Evol.%).

Il reste une dernière chose pour que cela soit parfait.
Dans cette colonne 6, à la place d'une valeur je peux avoir une erreur #N/A et dans ce cas la macro se bloque.
Qu'est ce que je dois ajouter à la macro pour ne pas qu'elle bloque ??? Dans ce cas il ne faut pas changer la couleur de l'objet et passer à la suivante.

Encore mille merci pour ton aide.
Je suis heureux de voir que grâce à l'internet il est possible de développer des communautés qui s'entraident à travers le monde.

Antidox.

 

[Minick]

Re : Macro changemet decouleur d'un objet

Salut,

On ajoute un controle sur l'expression (la valeur d'evol)

Option Explicit

Private Sub Worksheet_Calculate()
    Dim L As Byte
    Dim Couleur As Long
    
    With Sheets("PAYS")
        For L = 4 To 15
            [COLOR=Red]If Not IsError(.Cells(L, 6).Value) Then[/COLOR]
                If .Cells(L, 6).Value > 0 Then
                    Couleur = 11
                Else
                    Couleur = 10
                End If
                On Error Resume Next
                    .Shapes(.Cells(L, 3).Value).Fill.ForeColor.SchemeColor = Couleur
                On Error GoTo 0
            [COLOR=Red]End If[/COLOR]
        Next L
    End With
End Sub

J'ai mi la modif en rouge.
Par contre, l'objet conservera la couleur de la derniere evol valide.
On peut eventuellement mettre l'objet en blanc en cas d'erreur comme ceci:

Option Explicit

Private Sub Worksheet_Calculate()
    Dim L As Byte
    Dim Couleur As Long
    
    With Sheets("PAYS")
        For L = 4 To 15
            If Not IsError(.Cells(L, 6).Value) Then
                If .Cells(L, 6).Value > 0 Then
                    Couleur = 11
                Else
                    Couleur = 10
                End If
            Else
                Couleur = 9
            End If
            
            On Error Resume Next
                .Shapes(.Cells(L, 3).Value).Fill.ForeColor.SchemeColor = Couleur
            On Error GoTo 0
        Next L
    End With
End Sub

 

[Antidox]

Re : Macro changemet decouleur d'un objet

Encore une fois merci beaucoup.

Ça marche parfaitement !!!
J'espère que la solution profitera également à d'autres personnes.

Antidox.