Insérer un rectangle avec des conditions

Bonjour,

Après plusieurs essais, je ne trouve pas la solution.

Dans mon fichier excel, il y a une colonne "tests" et un ligne avec des nombres, mon but est d'insérer un rectangle en fonction du test qui vient d'etre rentré et de l'intervalle des nombres

Sub Macro1()

Dim Cel As Range

Dim x As Integer

nom = InputBox("Saisir un test", "saisi")

nb1 = InputBox("Saisir début de l'intervalle", "saisi")
nb2 = InputBox("Saisir la fin de l'intervalle", "saisi")

x = 6

For Each Cel In Range("C4:C10")
     If Cel.Value = "" Then
        Cel.Value = nom
        Exit For
     End If
     x = x + 1
Next Cel

Dim y As Integer

For Each Cel In Range("D3:H3")
    y = y + 1
    If Cel.Value = nb Then
        Exit For
    End If
Next Cel

'
   With Cells(x, y)

    ActiveSheet.Shapes.AddShape(msoShapeFlowchartTerminator, y, y, 50, 15).Select
    End With

End Sub

Mon soucis est qu'il s'insère en haut à gauche de la feuille

Bonjour

Pourquoi ne pas mettre simplement les cellules en couleur plutot que d'utiliser des objets sur votre feuille ?

Les objets sur les feuilles c'est toujours un peu le souc assuré à un moment ou un autre

Cordialement

Edit : vous pourriez même appliquer la couleur via click dans les cellules par exemple plutot que de passer par des inputbox

Bonjour,

With Cells(x, y)
    ActiveSheet.Shapes.AddShape msoShapeFlowchartTerminator, .Left, .Top, 50, 15
End With

Bonjour Dan,

A la base dans le fichier original, cela remplie les cases en couleur, je voulais simplement explorer d'autres possibilités.

Merci pour le conseil !

Bonjour thev,

Merci de ta réponse, je vais pouvoir continuer d'explorer cette possibilité

A +

A la base dans le fichier original, cela remplie les cases en couleur, je voulais simplement explorer d'autres possibilités.

Ok je comprends. Pensez que si vous modifiez la dimension des cellules, l'objet ne va pas bouger.

Cordialement

C'est sur que dans l'optique d'une meilleur ergonomie, utiliser des objets n'est pas la meilleur solution