Discussion :

[vdxxx]

Bonjour,

j'ai réussis à faire une macro qui, en fonction d'une valeur de cellule, modifie la couleur d'une forme (ellipse) . Elle a cette tête (voir dessous)

Mais j'aimerai que la macro "s'active" automatiquement dés qu'une valeur est modifiée dans le classeur, et si possible que le classeur ne se nome pas .xlsm mais .xlsx, et puis si vous avez une idée pour condenser mon script.

est ce possible? si oui pouvez vous m'indiquer comment y arriver?

merci d'avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
 
Sheets("graph").Select
'           ***************
'           ** résultat **
'           ***************
's'il y a aucun accident couleur vert
'
If Sheets("résultat de v").Range("Q4") = 0 Then
ActiveSheet.Shapes("Ellipse 13").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(140, 255, 140)
End If
'
's'il y a 1 accident couleur bleu
'
If Sheets("résultat de v").Range("Q4") = 1 Then
ActiveSheet.Shapes("Ellipse 13").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(20, 200, 240)
End If
'
's'il y a 2 accidents couleur orange
'
If Sheets("résultat de v").Range("Q4") = 2 Then
ActiveSheet.Shapes("Ellipse 13").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(246, 139, 50)
End If
'
's'il y a 3 accidents  ou plus couleur rouge
'
If Sheets("résultat de v").Range("Q4") >= 3 Then
ActiveSheet.Shapes("Ellipse 13").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If

[mercatog]

à mettre sur l'évènement change de la feuille "résultat de v"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
Dim klr As Single
If Target.Address = "$Q$4" Then
    Select Case Target.Value
        Case 0: klr = RGB(140, 255, 140)
        Case 1: klr = RGB(20, 200, 240)
        Case 2: klr = RGB(246, 139, 50)
        Case Is >= 3: klr = RGB(255, 0, 0)
    End Select
    Sheets("graph").Select
    ActiveSheet.Shapes("Ellipse 13").Select
    Selection.ShapeRange.Fill.ForeColor.RGB = klr
End If
End Sub

[vdxxx]

je te remercie vraiement mercatog!!

ca marche mieux que sur le plan!!!

un grand merci a toi et au site qui permet ces échanges.

MERCI