Associer formes à code couleur

Le 19/12/2015 à 11:07

Bonjour à toutes et à tous

D'après le fichier suivant

24associer-forme-et-couleur.zip (24.57 Ko)

comment associer les formes geometriques au code de couleur ??

J'ai validé le gestionnaires de nom ...mais je coince après !!!

merci d(avance Bernard

Le 20/12/2015 à 00:04

Salut Bernard,

asso a écrit :
comment associer les formes geometriques au code de couleur ??

Que veux-tu dire par là ? Quel est ton but réel ?

Cordialement.

NB : Sur ce Forum on considère que d'écrire en majuscules correspond à crier Peux-tu éditer ton titre et l'inscrire en minuscules, s'il-te-plait ?

Le 20/12/2015 à 09:04

Désolé je mets souvent en majuscules car ma vue n'est pas bonne

je souhaite pouvoir modifier les nombres ( 1 ou 2 ou 3) dans la colonne B2 à B9

pour modifier automatiquement les couleurs des formes ( de A à H)

Le 20/12/2015 à 10:26

Tout d’abord je te salue sympathiquement et te remercie infiniment de bien avoir voulu te donner la peine de me répondre, très Cher Ami,

Je me suis parfois demandé pourquoi Sébastien avait inscrit le point 5 de sa charte, mais maintenant je comprends. Va donc consulter ce lien: https://forum.excel-pratique.com/annonces/explications-et-regles-a-respecter-t13.html

Ceci étant dit, voici une macro qui –placé dans le code de la feuille – modifie les couleurs de la première de tes formes uniquement :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer

Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub

If Not Application.Intersect(Target, Range("B2")) Is Nothing Then
        ActiveSheet.Shapes.Range(Array("Ellipse 1")).Select
        If Target = 1 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
        Else
        If Target = 2 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)
        Else
        If Target = 3 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
        Else
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End If
        End If
        End If
End If

Si celui-ci te convient, soit tu arrives à l’appliquer toi-même à tes autres formes, soit je peux le faire pour toi.

Cordialement.

18associer-formes-et-couleurs-v1.zip (30.89 Ko)

Le 20/12/2015 à 23:05

merci de l'aide

je regarde le fonctionnement

Le 21/12/2015 à 18:32

Bonjour et merci

cela repond parfaitement a mon exercice

j' ai généré pour chaque valeur de la colonne B la recopie du programme

en mentionnant le nom de l objet corrrespondant

tout fonctionne

cordialement

Bernard

Le 21/12/2015 à 18:42

asso a écrit :
j' ai généré pour chaque valeur de la colonne B la recopie du programme

Aïe, aïe, aïe, c’est bien ce que je craignais

J’espérais secrètement que tu me dises que tu avais besoin d’aide et que je voie comment passer par un certain nombre de conditions IF ou en passant par un SELECT CASE pour donner le nom de toutes les formes à une variable quelconque de manière à ne pas devoir répéter autant de fois les 4 conditions If Target = X then.

Mais bon, peux-tu éventuellement me montrer ta macro actuelle et je verrais si j’ai une fois le temps de réaliser mon autre idée et si ça vaut surtout la peine de continuer à chercher ?

Amicalement.

Le 21/12/2015 à 23:05

Bonjour

voici la macro

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer

Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub

'PROCEDURE POUR L ELIPSE

If Not Application.Intersect(Target, Range("B2")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Ellipse 1")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

' PROCEDURE POUR LE LOSANGE

If Not Application.Intersect(Target, Range("B3")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Losange 3")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

'PROCEDURE POUR LE RECTANGLE 2

If Not Application.Intersect(Target, Range("B4")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

'PROCEDURE POUR LE TRIANGLE

If Not Application.Intersect(Target, Range("B5")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Triangle isocèle 6")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

' PROCEDURE TRAPEZE

If Not Application.Intersect(Target, Range("B6")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Trapèze 7")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

' PROCEDURE RECTANGLE 4

If Not Application.Intersect(Target, Range("B7")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

' PROCEDURE PARRALLELOGRAMME

If Not Application.Intersect(Target, Range("B8")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Parallélogramme 23")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

' PROCEDURE HEXAGONE

If Not Application.Intersect(Target, Range("B9")) Is Nothing Then

ActiveSheet.Shapes.Range(Array("Hexagone 24")).Select

If Target = 1 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)

Else

If Target = 2 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)

Else

If Target = 3 Then

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)

End If

effectivement si je rajoute des formes geometriques je repete le code

a chaque fois.............peut etre une boucle avec variable. ???..

cordialement

Bernard

Le 22/12/2015 à 23:13

Salut Bernard,

Merci pour le nom des formes que je n’ai ainsi pas eu besoin de chercher

Voici un code plus simple qui permettrait – le cas échéant – de pouvoir modifier les références aux couleurs qu’une seule fois ou de rajouter sans trop de complication des formes en plus.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer

Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub

If Not Application.Intersect(Target, Range("B2:B9")) Is Nothing Then

        If Target.Row = 2 Then ActiveSheet.Shapes.Range(Array("Ellipse 1")).Select
        If Target.Row = 3 Then ActiveSheet.Shapes.Range(Array("Losange 3")).Select
        If Target.Row = 4 Then ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
        If Target.Row = 5 Then ActiveSheet.Shapes.Range(Array("Triangle isocèle 6")).Select
        If Target.Row = 6 Then ActiveSheet.Shapes.Range(Array("Trapèze 7")).Select
        If Target.Row = 7 Then ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
        If Target.Row = 8 Then ActiveSheet.Shapes.Range(Array("Parallélogramme 23")).Select
        If Target.Row = 9 Then ActiveSheet.Shapes.Range(Array("Hexagone 24")).Select

        If Target = 1 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
        Else
        If Target = 2 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 80)
        Else
        If Target = 3 Then
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
        Else
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End If
        End If
        End If
End If

ActiveCell.Offset(0, 0).Activate

End Sub

Amicalement.

12associer-formes-et-couleurs-v3.zip (31.52 Ko)

Le 23/12/2015 à 00:32

Bonjour

Une autre façon de faire

14asso-associer-forme-et-couleur-v001.xlsm (20.57 Ko)

Rechercher des sujets similaires à "associer formes code couleur"