Automatiser un fichier

Bonjour,

Je suis entrain de chercher a automatiser au maximum un fichier. Ce fichier est un tableau de bord

J'aimerai pouvoir mettre des smileys en guise d'indicateur sur mes graphiques en automatique.

J'ai réussi grâce a un code donné sur le forum a automatisé les images avec un chiffre à taper dans une case.

Cependant le chiffre n'est pas réellement a taper puisqu'il est obtenue d'après une formule.

J'aimerai donc ne pas être obligé de taper le chiffre dans la case mais que cela se fasse tout seul et mette la bonne image en fonction du résultat.

Je joins un fichier ou les cases contenant le chiffre sont R9 et R16 et la formule de ces cases est X29/X30 *100

Merci de votre aide

Bien cordialement,

17classeur1.xlsm (310.01 Ko)

Bonjour, un essai de modification : pour ce faire il vous faut supprimer la private sub "Change" et la remplacer par Calculate. En somme à chaque re calcul de la feuille, le code sera lancé. Il n'y a plus de notion de Target car les cellules R9 et R16 ne sont plus "surveillées" en "change". Du coup il faut passer les deux cellules "en test" à la suite, puis tester le résultat pour afficher l'icône général.

Voici le code avec les modifications :

Private Sub Worksheet_Calculate()
    Dim ROUGE As Boolean, ORANGE As Boolean, VERT As Boolean
    'If Not Intersect(Target, Range("R9,R16")) Is Nothing Then
        'numéro_groupe = ((Target.Row - 9) / 7) + 1
        With ActiveSheet
            If [R9].Value < 0 Or [R9].Value > 500 Then
                .Shapes("Jaune 1").Visible = True
                .Shapes("Rouge 1").Visible = True
                .Shapes("Vert 1").Visible = True
                Total(0) = 0
            ElseIf [R9].Value >= 0 And [R9].Value <= 90 Then
                .Shapes("Jaune 1").Visible = False
                .Shapes("Rouge 1").Visible = False
                .Shapes("Vert 1").Visible = True
                Total(0) = 3
            ElseIf [R9].Value > 90 And [R9].Value <= 110 Then
                .Shapes("Jaune 1").Visible = True
                .Shapes("Rouge 1").Visible = False
                .Shapes("Vert 1").Visible = False
                Total(0) = 2
            ElseIf [R9].Value > 110 And [R9].Value <= 500 Then
                .Shapes("Jaune 1").Visible = False
                .Shapes("Rouge 1").Visible = True
                .Shapes("Vert 1").Visible = False
                Total(0) = 1
            End If

            If [R16].Value < 0 Or [R16].Value > 500 Then
                .Shapes("Jaune 2").Visible = True
                .Shapes("Rouge 2").Visible = True
                .Shapes("Vert 2").Visible = True
                Total(1) = 0
            ElseIf [R16].Value >= 0 And [R16].Value <= 90 Then
                .Shapes("Jaune 2").Visible = False
                .Shapes("Rouge 2").Visible = False
                .Shapes("Vert 2").Visible = True
                Total(1) = 3
            ElseIf [R16].Value > 90 And [R16].Value <= 110 Then
                .Shapes("Jaune 2").Visible = True
                .Shapes("Rouge 2").Visible = False
                .Shapes("Vert 2").Visible = False
                Total(1) = 2
            ElseIf [R16].Value > 110 And [R16].Value <= 500 Then
                .Shapes("Jaune 2").Visible = False
                .Shapes("Rouge 2").Visible = True
                .Shapes("Vert 2").Visible = False
                Total(1) = 1
            End If

            If Total(0) = 1 Or Total(1) = 1 Then
                .Shapes("JAUNE").Visible = False
                .Shapes("ROUGE").Visible = True
                .Shapes("VERT").Visible = False
            ElseIf Total(0) = 3 And Total(1) = 3 Then
                .Shapes("JAUNE").Visible = False
                .Shapes("ROUGE").Visible = False
                .Shapes("VERT").Visible = True
            ElseIf Total(0) = 2 Or Total(1) = 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

Merci beaucoup vbMBHB,

il me semble que c'était déjà toi pour le premier code.

encore merci

bien cordialement,

Je crois en effet, ce qui me donne "un avantage" pour répondre...

Merci.

vbMBHB

Rechercher des sujets similaires à "automatiser fichier"