Simplification code VBA

[maninwhite]

Bonjour à toutes et à tous

Je reviens sur le forum afin d'obtenir la simplification du code suivant.

Ce code me permet de colorer des formes automatiques suivant la valeur d'une cellule.

Merci

Worksheets("Stats FY 1314").Activate
With Worksheets("Stats FY 1314")

If Range("B93").Value >= 1 Then
ActiveSheet.Shapes("tete").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("Oval 8").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B94").Value >= 1 Then
ActiveSheet.Shapes("oeild").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("oeild").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B95").Value >= 1 Then
ActiveSheet.Shapes("oeilg").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("oeilg").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B96").Value >= 1 Then
ActiveSheet.Shapes("cou").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("cou").DrawingObject.Interior.ColorIndex = 4
End If

If Range("B97").Value >= 1 Then
ActiveSheet.Shapes("epauleD").DrawingObject.Interior.ColorIndex = 3
Else: ActiveSheet.Shapes("epauleD").DrawingObject.Interior.ColorIndex = 4
End If

End With

 

[pierrejean]

Re : Simplification code VBA

Bonjour maninwhite

A tester:

cellules = Array(93, 94, 95, 96, 97)
corps = Array("tete", "oeild", "oeilg", "cou", "epauleD")
For n = LBound(cellules) To UBound(cellules)
 If Range("B" & cellules(n)).Value >= 1 Then
 ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 3
 Else: ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 4
Next

 

[Hervé]

Re : Simplification code VBA

bonjour

une solution à tester :

Worksheets("Stats FY 1314").Activate

With Worksheets("Stats FY 1314")
    For i = 93 To 97
        Select Case i
            Case 93: a = "tete": b = "Oval 8"
            Case 94: a = "oeild": b = "oeild"
            Case 95: a = "oeilg": b = "oeilg"
            Case 96: a = "cou": b = "cou"
            Case 97: a = "epauleD": b = "epauleD"
        End Select
        If .Range("b" & i) >= 1 Then
            ActiveSheet.Shapes(a).DrawingObject.Interior.ColorIndex = 3
        Else
            ActiveSheet.Shapes(b).DrawingObject.Interior.ColorIndex = 4
        End If
    Next i
End With

salut

edit : coucou pierrejean, content de te croiser, joli code minimaliste

 

[maninwhite]

Re : Simplification code VBA

Merci à vous deux pour les solutions apportées.

Au final, j'ai retenu celle de Hervé

 

[pierrejean]

Re : Simplification code VBA

Re

Salut Hervé
Heureux également de te croiser à nouveau (tu te fais vraiment rare en ce moment)
Correction : Avais pas percuté l'Ovale

cellules = Array(93, 94, 95, 96, 97)
corps = Array("tete", "oeild", "oeilg", "cou", "epauleD")
corps_b=Array("Oval 8","oeild", "oeilg", "cou", "epauleD")
For n = LBound(cellules) To UBound(cellules)
 If Range("B" & cellules(n)).Value >= 1 Then
 ActiveSheet.Shapes(corps(n)).DrawingObject.Interior.ColorIndex = 3
 Else: ActiveSheet.Shapes(corps_b(n)).DrawingObject.Interior.ColorIndex = 4
Next

 

[maninwhite]

Re : Simplification code VBA

L'Ovale était une faute dans mon code donc ton premier code fonctionnait parfaitement bien pierrejean