pb de formules couleur ellipse

pakalom

XLDnaute Junior
bonjour ,

je suis entrain de creer un fichier ou je colore une ellipse d'une certaine couleur selon critere,

une ellipse ca marchec mais des que je fais deux ellipse mes formules ne marche pas

pouvez vous m'aider.

Merci
 

Pièces jointes

  • chgtcouleur.xls
    23 KB · Affichages: 52

Hulk

XLDnaute Barbatruc
Re : pb de formules couleur ellipse

Hello,

Essaie comme ceci..
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Target, [A1]) Is Nothing Then
        If Target.Address = "$A$1" Then
            ActiveSheet.Shapes("ellipse 1").Select
            Selection.Characters.Text = Target.Value
            If Target = "occupee" Then
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
                Range("a35").Select
            End If
        If Target = "libre" Then
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
            Range("a35").Select
        End If
        End If
    End If
    
    If Not Application.Intersect(Target, [A2]) Is Nothing Then
        If Target.Address = "$A$2" Then
            ActiveSheet.Shapes("ellipse 2").Select
            Selection.Characters.Text = Target.Value
            If Target = "libre" Then
                Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
                Range("a35").Select
            End If
        If Target = "occupee" Then
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
            Range("a35").Select
        End If
        End If
    End If

End Sub
Sur ce, bonne nuit !
 

Cousinhub

XLDnaute Barbatruc
Re : pb de formules couleur ellipse

Bonjour,

Ton erreur provient de ta première condition "If Target.Address...."

Tu ne testes que si l'adresse est A1, si non, tu sors....

essaie avec ce code :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
    With ActiveSheet.Shapes("ellipse " & Target.Row)
        .DrawingObject.Caption = Target.Value
        If Target = "occupee" Then
            .DrawingObject.Interior.ColorIndex = 10
        ElseIf Target = "libre" Then
            .DrawingObject.Interior.ColorIndex = 13
        End If
    End With
End If
End Sub
 

Pièces jointes

  • chgtcouleur_v1.zip
    8.7 KB · Affichages: 31

Statistiques des forums

Discussions
312 931
Messages
2 093 721
Membres
105 796
dernier inscrit
Max...26