Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Recharger cette page [XL-2007] Shape visible ou invisible selon valeur de cellule
S'inscrire Règles FAQ Marquer les forums comme lus
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 28/11/2011, 15h04   #1
Invité de passage
 
Inscription : janvier 2008
Messages : 32
Détails du profil
Informations personnelles :
Âge : 34
Localisation : France, Haute Garonne (Midi Pyrénées)

Informations forums :
Inscription : janvier 2008
Messages : 32
Points : 2
Points : 2
Par défaut Shape visible ou invisible selon valeur de cellule
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 :
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 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
assiec est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 28/11/2011, 15h13   #2
Expert Confirmé Sénior
 
Avatar de jfontaine
 
Homme Jérôme FONTAINE
Contrôleur de Gestion
Inscription : juin 2006
Messages : 3 920
Détails du profil
Informations personnelles :
Nom : Homme Jérôme FONTAINE
Âge : 38
Localisation : France, Sarthe (Pays de la Loire)

Informations professionnelles :
Activité : Contrôleur de Gestion

Informations forums :
Inscription : juin 2006
Messages : 3 920
Points : 7 237
Points : 7 237
Bonjour,

Il faut juste adapter un peu ton code

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
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
__________________
Jérôme

Citation:
"Ils ne savaient pas que c'était impossible, alors ils l'ont fait" - Marc Twain
Si la réponse répond à votre besoin, votre vote nous encouragera.
Dans le cas ou la réponse mérite, à vos yeux, un , nous faire partager la raison de ce vote, pourrait nous permettre de nous améliorer.
jfontaine est déconnecté   Envoyer un message privé Réponse avec citation 10
Vieux 28/11/2011, 16h13   #3
Invité de passage
 
Inscription : janvier 2008
Messages : 32
Détails du profil
Informations personnelles :
Âge : 34
Localisation : France, Haute Garonne (Midi Pyrénées)

Informations forums :
Inscription : janvier 2008
Messages : 32
Points : 2
Points : 2
Merci beaucoup mes lacunes venaient des conditions SI mais j'ai modifié comme ceci car plus simple pour moi.

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
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.
assiec est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 28/11/2011, 21h50   #4
Expert Confirmé Sénior
 
Avatar de mercatog
 
Inscription : juillet 2008
Messages : 5 848
Détails du profil
Informations forums :
Inscription : juillet 2008
Messages : 5 848
Points : 13 907
Points : 13 907
Bonsoir
Ton code pourrait être écrit comme ceci (moins de lignes)
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
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.
__________________
Cordialement.
mercatog est déconnecté   Envoyer un message privé Réponse avec citation 10
Vieux 29/11/2011, 09h56   #5
Invité de passage
 
Inscription : janvier 2008
Messages : 32
Détails du profil
Informations personnelles :
Âge : 34
Localisation : France, Haute Garonne (Midi Pyrénées)

Informations forums :
Inscription : janvier 2008
Messages : 32
Points : 2
Points : 2
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é.
assiec est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 08h01.

Nous contacter - Developpez.com - Archives - Haut de page

 
 
Developpez.com

Nous contacter

Participez

Informations légales

 
Services

Forum Excel

Blogs

Hébergement

 
Partenaires

Hébergement Web