Menu

Mise en forme conditionnelle compris entre vba excel [Résolu]

Messages postés
98
Date d'inscription
lundi 2 octobre 2017
Statut
Membre
Dernière intervention
1 juillet 2019
-
Bonjour,

J'ai un problème pour appliquer des formes conditionnelles, en pourcentage.

J'ai composé un code vba pour modifier automatiquement les couleurs de mes formes (Objet) selon un résultat que j'agrémente dans une cellule "N15"

Toutes les conditions à appliquer ce situent dans des cellules, pour permettre à l'utilsateur de les modifier quand il veut.

Çà fonctionne très bien pour les conditions inférieur et égal à
et supérieur et égal à.

Par contre pour la conditions comprise entre, cela ne fonctionne pas
Exemple : Case Range("T8") To Range("U8")

Mon code,

Private Sub Worksheet_Change(ByVal Target As Range) 

If Not Application.Intersect(Target, Range("N15")) Is Nothing Then 'a adapter la cellule 

Select Case Target.Value 

Case Is >= Range("T7") 
ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 10066431 'rose 

Case Range("T8") To Range("U8") 
ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 49407 'orange 

Case Range("T9") To Range("U9") 
ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5296274 'vert clair 

Case Is <= Range("T10") 
ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5287936 'vert foncé 

End Select 

End if 

End sub




Les données conditionnelles que mon code va chercher dans des cellules pour colorier mes formes :

supérieure à 0% => "T7"=0,0%
entre 0 et -1% => "T8"=0,0% "U8"=-1,0%
entre -1 et -2% => "T9"=-1,0% "U9"=-2,0%
inférieure à -2% => "T10"=-2,0%


Ça fonctionne aussi très bien pour faire varier les couleurs de la cellule "N15"
avec des mises en formes conditionnelles habituelles sans VBA"

ROSE
> = 0
Color = 10066431

ORANGE
ENTRE 0 ET -0.01
Color = 49407

VERT CLAIR
ENTRE -0.01 ET -0.02
Color = 5296274

VERT FONCE
< = -0.02
Color = 5287936


Malgré plusieurs recherches je ne trouve pas de solution,

je joint un fichier test
https://www.cjoint.com/c/IFDiNvbud7c

Merci pour toute aide sur ce sujet.
Afficher la suite 

8 réponses

Messages postés
1965
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
6 juillet 2019
213
0
Merci
Bonjour,

En commençant par les égalités puis les autres

            Case Is = Range("T8"), Range("U8")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 49407 'orange
        
            Case Is = Range("T9"), Range("U9")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5296274 'vert clair
        
            Case Is <= Range("T10")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5287936 'vert foncé
            
            Case Is >= Range("T7")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 10066431 'rose


Cdlt
Commenter la réponse de Frenchie83
Messages postés
98
Date d'inscription
lundi 2 octobre 2017
Statut
Membre
Dernière intervention
1 juillet 2019
0
Merci
Bonjour Frenchie83,

merci

mai quand je saisi -1,5% dans la cellule "N15" je devrais avoir le vert clair mais la couleur de la forme ne change pas.

Les valeurs à prendre pour la forme conditionnelle de l'objet est
compris entre "T9" =-1,01 et "U9" =-0,02 pour le vert clair

La forme conditionnelle appliqué à la cellule "N15" pour le vert clair est
est comprise entre =-1,01 et =-0,02

Et quand je saisi -1,5% dans la cellule "N15" la forme conditionnelle pour la cellule met bien "N15" en vert clair mais l'objet non.
Commenter la réponse de AstraLife
Messages postés
1965
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
6 juillet 2019
213
0
Merci
Bonjour,

A quel endroit dans votre macro traitez-vous "Paris 05"?, Ne manque-t-il pas un petit morceau?

Si vous ajoutez la partie manquante, vous verrez que cela fonctionne bien.

CDlt
Commenter la réponse de Frenchie83
Messages postés
98
Date d'inscription
lundi 2 octobre 2017
Statut
Membre
Dernière intervention
1 juillet 2019
0
Merci
Je traite Paris 05 en premier mais chaque arrondissement de paris à sa cellule de résultat,
je cherche à faire varier les couleurs des formes des arrondissements en fonction du résultat que je saisi dans les cellules N15, N16, ect.....il n'y a pas d'importance dans le sens de traitement des arrondissements je pense sur tout changement dans la worksheet ?


Private Sub Worksheet_Change(ByVal Target As Range)

'-------------------------------------------------'
'Gestion des mises en formes sur la cartographie  '
'-------------------------------------------------'
    
    '------------------------'
    'MISE EN FORME PARIS 05  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N15")) Is Nothing Then 'a adapter la cellule

        Select Case Target.Value

            Case Is = Range("T8"), Range("U8")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 49407 'orange
        
            Case Is = Range("T9"), Range("U9")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5296274 'vert clair
        
            Case Is <= Range("T10")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5287936 'vert foncé
            
            Case Is >= Range("T7")
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 10066431 'rose
        
        End Select
    
    End If
           
    '------------------------'
    'MISE EN FORME PARIS 06  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N16")) Is Nothing Then 'a adapter la cellule

        Select Case Target.Value

            Case Is = Range("T8"), Range("U8")
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 49407 'orange
        
            Case Is = Range("T9"), Range("U9")
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 5296274 'vert clair
        
            Case Is <= Range("T10")
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 5287936 'vert foncé
            
            Case Is >= Range("T7")
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 10066431 'rose
                
        End Select

    End If

End Sub
Commenter la réponse de AstraLife
Messages postés
1965
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
6 juillet 2019
213
0
Merci
Je ne comprends pas à quoi sert la première partie puisque chaque éléments voit sa couleur changer en fonction de la valeur donnée en colonne N.

Ceci suffit, si j'ai bien compris
Private Sub Worksheet_Change(ByVal Target As Range)
'-------------------------------------------------'
'Gestion des mises en formes sur la cartographie  '
'-------------------------------------------------'
    '------------------------'
    'MISE EN FORME PARIS 05  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N15")) Is Nothing Then 'a adapter la cellule
       Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If
    
    '------------------------'
    'MISE EN FORME PARIS 06  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N16")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 06").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If
    
    '------------------------'
    'MISE EN FORME PARIS 07  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N17")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 07").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 07").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If
    
    '------------------------'
    'MISE EN FORME PARIS 11  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N18")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 11").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 11").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If
    
    '------------------------'
    'MISE EN FORME PARIS 13  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N20")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 13").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 13").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If

    '------------------------'
    'MISE EN FORME PARIS 14  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N21")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 14").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 14").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If

    '------------------------'
    'MISE EN FORME PARIS 12  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N19")) Is Nothing Then 'a adapter la cellule
        Select Case Target.Value
            Case Is > 0
            ActiveSheet.Shapes("Paris 12").DrawingObject.Interior.Color = 10066431 'rose
            Case Is < -0.02
            ActiveSheet.Shapes("Paris 12").DrawingObject.Interior.Color = 5287936 'vert foncé
        End Select
    End If
End Sub


Cdlt
Commenter la réponse de Frenchie83
Messages postés
98
Date d'inscription
lundi 2 octobre 2017
Statut
Membre
Dernière intervention
1 juillet 2019
0
Merci
Le code dans le fichier joint n'est pas complet, j'ai testé pour la mise en forme de Paris 05 avant de répéter sur les autres arrondissements.

La cellule "N15" possède une mise en forme conditionnelle sur 4 conditions que je souhaite appliquer aussi à la forme de l'arrondissement.

Quand je change la valeur de la cellule "N15" elle varie bien sur 4 couleurs, rose >=0, orange comprise entre 0 et -0.01, vert clair comprise entre -0.1 et -0.02 et vert foncé <= -0.02

je voudrais que la forme prennes les mêmes couleurs.
Et pour éviter de modifier souvent le code vba je voulais aller chercher les conditions dans des cellules plutôt que de l'écrire dans le code tel que Case Is < -0.02 mais plutôt Case Is <= Range("T10")
Commenter la réponse de AstraLife
Messages postés
1965
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
6 juillet 2019
213
0
Merci
Bonjour,

Attention aux écritures dans le tableau T7:U10, notamment à la conversion des valeurs numériques en pourcentages

 '------------------------'
    'MISE EN FORME PARIS 05  '
    '------------------------'
    If Not Application.Intersect(Target, Range("N15")) Is Nothing Then 'a adapter la cellule
        If Target.Value >= Range("T7") Then '>=0
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 10066431 'rose
        ElseIf Target.Value < Range("T8") And Target.Value >= Range("U8") Then '<0 et >=-0.01
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 49407 'orange
        ElseIf Target.Value < Range("T9") And Target.Value >= Range("U9") Then '<-0.01 et >=-0.02
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5296274 'vert clair
        ElseIf Target.Value < Range("T10") Then '<-0.02
            ActiveSheet.Shapes("Paris 05").DrawingObject.Interior.Color = 5287936 'vert foncé
        End If
    End If


Avec le fichier
https://mon-partage.fr/f/X31GZoHd/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
98
Date d'inscription
lundi 2 octobre 2017
Statut
Membre
Dernière intervention
1 juillet 2019
0
Merci
Oui c'est vrai que je ne savais plus trop pour les pourcentages

Ça fonctionne très bien !

Un grand merci à vous pour votre aide et pour vos explications.
Commenter la réponse de AstraLife