Automatiser des images
Bonjour
J'ai un petit fichier qui automatise trois images mais je n'arrive pas a le dupliquer pour gérer d'autre image
Je souhaiterai faire la même chose que ce code la mais sur des autres images
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$10" Then Exit Sub
'If Target.Value < 0 Or Target.Value > 100 Then Exit Sub
With ActiveSheet
If Target.Value < 0 Or Target.Value > 100 Then
.Shapes("Jaune 1").Visible = True
.Shapes("Rouge 1").Visible = True
.Shapes("Vert 1").Visible = True
End If
If Target.Value >= 0 And Target.Value <= 40 Then 'VERT image3
.Shapes("Jaune 1").Visible = False
.Shapes("Rouge 1").Visible = False
.Shapes("Vert 1").Visible = True
End If
If Target.Value > 40 And Target.Value <= 60 Then 'JAUNE image1
.Shapes("Jaune 1").Visible = True
.Shapes("Rouge 1").Visible = False
.Shapes("Vert 1").Visible = False
End If
If Target.Value > 60 And Target.Value <= 100 Then 'ROUGE image2
.Shapes("Jaune 1").Visible = False
.Shapes("Rouge 1").Visible = True
.Shapes("Vert 1").Visible = False
End If
End With
End Sub
Je joins mon fichier
J'aimerai pouvoir dupliquer ce code à 2 autres triplettes d'image
1 faire un autre code en fonction des images des trois triplette
Si 1 sur les 3 rouge alors => Rouge
Si les 3 sont vert alors => vert
si dans les 3 il y a 1 jaune 2 vert alors => Jaune
Bien cordialement,
Bonsoir, un peu de nettoyage, d'alignement, de transparence, ajour de variables "interrupteur", un tableau pour mettre tout ceci en mémoire, mise en variable des groupes d'images, un calcul pour connaître sur quel groupe on "travaille" et le tour est joué ! Voyez le fichier joint :
N'oubliez pas de rendre anonyme vos fichiers.
vbMBHB
Bonjour,
Vraiment super c'est exactement ce que je recherche je l'adapterai a mon fichier mais merci bien
par contre il y a un soucis avec les grandes images elles ne sont gérées que par la dernière ligne.
exemple si 1 est vert 2 est jaune et 3 est vert le grand est vert ... or il devrait être jaune.
cordialement,
Bonjour, autant pour moi je me croyais assez fort pour faire un système de test avec boucle mais ce n'est pas le cas... Voici le code de remplacement :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ROUGE As Boolean, ORANGE As Boolean, VERT As Boolean
If Not Intersect(Target, Range("A9,A16,A23")) Is Nothing Then
numéro_groupe = ((Target.Row - 9) / 7) + 1
With ActiveSheet
If Target.Value < 0 Or Target.Value > 100 Then
.Shapes("Jaune " & numéro_groupe).Visible = True
.Shapes("Rouge " & numéro_groupe).Visible = True
.Shapes("Vert " & numéro_groupe).Visible = True
Total(numéro_groupe - 1) = 0
ElseIf Target.Value >= 0 And Target.Value <= 40 Then
.Shapes("Jaune " & numéro_groupe).Visible = False
.Shapes("Rouge " & numéro_groupe).Visible = False
.Shapes("Vert " & numéro_groupe).Visible = True
Total(numéro_groupe - 1) = 3
ElseIf Target.Value > 40 And Target.Value <= 60 Then
.Shapes("Jaune " & numéro_groupe).Visible = True
.Shapes("Rouge " & numéro_groupe).Visible = False
.Shapes("Vert " & numéro_groupe).Visible = False
Total(numéro_groupe - 1) = 2
ElseIf Target.Value > 60 And Target.Value <= 100 Then
.Shapes("Jaune " & numéro_groupe).Visible = False
.Shapes("Rouge " & numéro_groupe).Visible = True
.Shapes("Vert " & numéro_groupe).Visible = False
Total(numéro_groupe - 1) = 1
End If
If Total(0) = 1 Or Total(1) = 1 Or Total(2) = 1 Then
.Shapes("JAUNE").Visible = False
.Shapes("ROUGE").Visible = True
.Shapes("VERT").Visible = False
ElseIf Total(0) = 3 And Total(1) = 3 And Total(2) = 3 Then
.Shapes("JAUNE").Visible = False
.Shapes("ROUGE").Visible = False
.Shapes("VERT").Visible = True
ElseIf Total(0) = 2 Or Total(1) = 2 Or Total(2) = 2 Then
.Shapes("JAUNE").Visible = True
.Shapes("ROUGE").Visible = False
.Shapes("VERT").Visible = False
Else
.Shapes("JAUNE").Visible = True
.Shapes("ROUGE").Visible = True
.Shapes("VERT").Visible = True
End If
End With
End If
End Sub
vbMBHB
Bonjour,
j'ai testé votre code et il marche parfaitement
Merci beaucoup
Merci,
vbMBHB