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,

5indicateur.xlsm (42.17 Ko)

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

Rechercher des sujets similaires à "automatiser images"