Créer une boucle avec Shape

Bonjour,

Je souhaiterai colorier des formes en fonction de la valeur d'une cellule. J'ai créer ce code ci :

If Cells(1, 2).Value = 1 Then
ActiveSheet.Shapes("Ellipse2").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(240, 230, 28) 'jaune
ElseIf Cells(1, 2) = 2 Then
ActiveSheet.Shapes("Ellipse2").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(195, 174, 206) 'violet
ElseIf Cells(1, 2).Value = 3 Then
ActiveSheet.Shapes("Ellipse2").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(151, 215, 115) 'vert clair

La prochaine étape serait de créer une boucle pour faire ceci sur toutes les formes de ellipse1, à ellipse50.

J'ai utilisé le code suivant, mais il y a un problème sur la fonction shape. Je pense que je me trompe sur le formalisme, mais je ne trouve pas la solution.

Dim x As Integer
For x = 1 To 50
If Cells(1, x).Value = 1 Then
ActiveSheet.Shapes("Ellipsex").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(240, 230, 28) 'jaune
ElseIf Cells(1, x) = 2 Then
ActiveSheet.Shapes("Ellipsex").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(195, 174, 206) 'violet
ElseIf Cells(1, x).Value = 3 Then
ActiveSheet.Shapes("Ellipsex").Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(151, 215, 115) 'vert clair
End If
Next x

Merci pour votre aide.

Bonjour macgivre67, le forum,

Un essai ...à l'aveugle...

code corrigé suite à la remarque de saboh12617

Sub test()
 Dim x As Integer
  Application.ScreenUpdating = False
   With ActiveSheet
    On Error Resume Next
    For x = 1 To 50
      Select Case .Cells(1, x).Value
      Case 1
      .Shapes("Ellipse " & x).Fill.ForeColor.RGB = RGB(240, 230, 28)  'jaune
      Case 2
      .Shapes("Ellipse " & x).Fill.ForeColor.RGB = RGB(195, 174, 206) 'violet
      Case 3
     .Shapes("Ellipse " & x).Fill.ForeColor.RGB = RGB(151, 215, 115) 'vert clair
      Case Else
     .Shapes("Ellipse " & x).Fill.ForeColor.RGB = RGB(70, 130, 180) 'quelle couleur si autre valeur ???
      End Select
     Next x
    End With
End Sub

Si non ok, prière de joindre un fichier représentatif.

Cordialement,

Bonjour,

Une proposition qui saute les formes (ellipses) qui n'existent pas/n'ont pas le bon nom.

Sub IterationFormes()
  Dim i As Long, myColor As Long
  For i = 1 To 50
    Select Case ActiveSheet.Cells(1, i).Value2
      Case 1
        myColor = RGB(240, 230, 28)
      Case 2
        myColor = RGB(195, 174, 206)
      Case 3
        myColor = RGB(151, 215, 115)
      Case Else
        Goto NumNonValide
    End Select
    ' essai de coloriage, si la forme existe, sinon on la saute
    On Error Resume Next
    ActiveSheet.Shapes("Ellipse" & i).Fill.ForeColor.RGB = myColor
    On Error GoTo 0
NumNonValide:
  Next i
End Sub

EDIT : salut xorsankukai, tu as les indices de lignes/colonnes qui ne correspondent pas à celle de l'op. Mais je ne sais pas s'il a vraiment ses données horizontales ?

Hello saboh12617,

Effectivement, j'avais inversé ligne et colonne

Bien vu la gestion d'erreur.

Amicalement,

Merci beaucoup pour vos réponse c'est nickel.

Bonne continuation