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,
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