Shape visible ou invisible selon valeur de cellule

Version imprimable

Bonjour,

Je souhaite rendre visible ou pas des objets (shape) selon des valeurs contenues dans des cellules.
Après recherche sur différents posts je suis arriver a adapter une bribe de code pour 2 objets qui dépendent de la cellule H7 (Answer_1).

Or je souhaite maintenant dans cette meme feuille faire la meme chose pour deux autres objets mais à partir d'une autre cellule H11 (Answer_2)...la je bloque
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub Worksheet_Change(ByVal Answer_1 As Range) If Answer_1.Address <> "$H$7" Then Exit Sub If Answer_1.Value = "YES" Then Select Case Answer_1.Value Case Is = "YES" ActiveSheet.Shapes("Connecteur en angle 23").Visible = True ActiveSheet.Shapes("Connecteur en angle 39").Visible = False End Select Else ActiveSheet.Shapes("Connecteur en angle 23").Visible = False ActiveSheet.Shapes("Connecteur en angle 39").Visible = True End If End Sub
Auriez vous quelques indices a me donner?
Merci par avance.
Cordialement

Bonjour,

Il faut juste adapter un peu ton code

Code:

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
Private Sub Worksheet_Change(ByVal Answer_1 As Range)
 
'Traitement H7
If Answer_1.Address = "$H$7" Then
    If Answer_1.Value = "YES" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Connecteur en angle 23").Visible = True
                ActiveSheet.Shapes("Connecteur en angle 39").Visible = False
         End Select
    Else
        ActiveSheet.Shapes("Connecteur en angle 23").Visible = False
        ActiveSheet.Shapes("Connecteur en angle 39").Visible = True
    End If
End If
 
'Traitement H1
If Answer_1.Address = "$H$1" Then
    If Answer_1.Value = "YES" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Connecteur en angle 23").Visible = True
                ActiveSheet.Shapes("Connecteur en angle 39").Visible = False
         End Select
    Else
        ActiveSheet.Shapes("Connecteur en angle 23").Visible = False
        ActiveSheet.Shapes("Connecteur en angle 39").Visible = True
    End If
End If
 
End Sub

Merci beaucoup mes lacunes venaient des conditions SI mais j'ai modifié comme ceci car plus simple pour moi.

Code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Private Sub Worksheet_Change(ByVal Answer_1 As Range)
' L1Q1 answer
If Answer_1.Address = "$H$7" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Connecteur en angle 2").Visible = True
                ActiveSheet.Shapes("Connecteur en angle 8").Visible = False
            Case Is = "NO"
                ActiveSheet.Shapes("Connecteur en angle 2").Visible = False
                ActiveSheet.Shapes("Connecteur en angle 8").Visible = True
            Case Is = ""
                ActiveSheet.Shapes("Connecteur en angle 2").Visible = False
                ActiveSheet.Shapes("Connecteur en angle 8").Visible = False
         End Select
End If
'L1Q2 answer
If Answer_1.Address = "$H$11" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Connecteur en angle 14").Visible = True
                ActiveSheet.Shapes("Connecteur en angle 22").Visible = False
            Case Is = "NO"
                ActiveSheet.Shapes("Connecteur en angle 14").Visible = False
                ActiveSheet.Shapes("Connecteur en angle 22").Visible = True
            Case Is = ""
                ActiveSheet.Shapes("Connecteur en angle 14").Visible = False
                ActiveSheet.Shapes("Connecteur en angle 22").Visible = False
            Case Is = "N/A"
                ActiveSheet.Shapes("Connecteur en angle 14").Visible = False
                ActiveSheet.Shapes("Connecteur en angle 22").Visible = False
         End Select
End If
'L1Q3 answer
If Answer_1.Address = "$H$15" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Forme 21").Visible = True
                ActiveSheet.Shapes("Forme 23").Visible = False
            Case Is = "NO"
                ActiveSheet.Shapes("Forme 21").Visible = False
                ActiveSheet.Shapes("Forme 23").Visible = True
            Case Is = ""
                ActiveSheet.Shapes("Forme 21").Visible = False
                ActiveSheet.Shapes("Forme 23").Visible = False
            Case Is = "N/A"
                ActiveSheet.Shapes("Forme 21").Visible = False
                ActiveSheet.Shapes("Forme 23").Visible = False
         End Select
End If
'L1Q4 answer
If Answer_1.Address = "$H$19" Then
        Select Case Answer_1.Value
            Case Is = "YES"
                ActiveSheet.Shapes("Connecteur en angle 26").Visible = True
                ActiveSheet.Shapes("Forme 24").Visible = False
            Case Is = "NO"
                ActiveSheet.Shapes("Connecteur en angle 26").Visible = False
                ActiveSheet.Shapes("Forme 24").Visible = True
            Case Is = ""
                ActiveSheet.Shapes("Connecteur en angle 26").Visible = False
                ActiveSheet.Shapes("Forme 24").Visible = False
            Case Is = "N/A"
                ActiveSheet.Shapes("Connecteur en angle 26").Visible = False
                ActiveSheet.Shapes("Forme 24").Visible = False
         End Select
End If
 
End Sub

Cependant, j'ai la nouvelle problématique suivante:

- Comment modifier le libellé des formes ?
- Est t'il possible qu'en copiant dans le meme classeur la feuille de travail, les formes gardent les memes nom?

Merci d'avance.

Bonsoir
Ton code pourrait être écrit comme ceci (moins de lignes)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Answer_1 As Range)
 
Select Case Answer_1.Address(0, 0)
        'L1Q1 answer
    Case "H7"
        Shapes("Connecteur en angle 2").Visible = UCase(Answer_1.Value) = "YES"
        Shapes("Connecteur en angle 8").Visible = UCase(Answer_1.Value) = "NO"
        'L1Q2 answer
    Case "H11"
        Shapes("Connecteur en angle 14").Visible = UCase(Answer_1.Value) = "YES"
        Shapes("Connecteur en angle 22").Visible = UCase(Answer_1.Value) = "NO"
        'L1Q3 answer
    Case "H15"
        Shapes("Forme 21").Visible = UCase(Answer_1.Value) = "YES"
        Shapes("Forme 23").Visible = UCase(Answer_1.Value) = "NO"
        'L1Q4 answer
    Case "H19"
        Shapes("Connecteur en angle 26").Visible = UCase(Answer_1.Value) = "YES"
        Shapes("Forme 24").Visible = UCase(Answer_1.Value) = "NO"
End Select
End Sub

Si tu copie toute la feuille, tes formes garderont le même nom.

29/11/2011, 09h56
assiec

Bonjour,
Merci pour cette simplification, je l'ai intégrée. Cependant, quand je copie la feuille dans le meme classeur j'ai toujour le problème des noms des formes.
Ils ne gardent pas le meme libellé.