Centrage automatique des toutes les fomes créer sur une feuille

Bonjour,

dans le fichier ci joint, j'insère des formes dans des cellules en fonction de valeurs dans la ligne 1.

Maintenant, je souhaiterais centrer toutes ces formes dans leurs cellules respectives.

J'ai essayé plusieurs choses, mais ca ne fonctionne pas.

Merci pour votre aide

Bonjour

Ton fichier en retour

il faut que tu mettes la hauteur de cellule un peut plus grande que tes formes

Merci Joco7915 pour ta rapidité. Mais il me semble que tu as renvoyé le même fichier que j'avais joint à mon précédent message.

Merci

Après plusieurs essais, Le code suivant semble fonctionner.

Sub shape()
ActiveSheet.Calculate
Dim x As Integer
Application.ScreenUpdating = False
With ActiveSheet
On Error Resume Next

For Each sh In ActiveSheet.Shapes
If Not sh.Name Like "Bouton" Then sh.Delete
Next sh

For x = 1 To 8
If Cells(1, x).Value = 1 Then
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 40, 40, 40, 40)
.Name = ("figure " & x)
.Top = Cells(5, x).Top + (Cells(5, x).Height - .Height) / 2
.Left = Cells(5, x).Left + (Cells(5, x).Width - .Width) / 2
End With
ElseIf Cells(1, x).Value = 2 Then
With ActiveSheet.Shapes.AddShape(msoShapeOval, 40, 40, 27, 40)
.Name = ("figure " & x)
.Top = Cells(5, x).Top + (Cells(5, x).Height - .Height) / 2
.Left = Cells(5, x).Left + (Cells(5, x).Width - .Width) / 2
End With
End If
Next x

End Sub

Bonjour,

Juste un petit retour : si vous souhaitez faire un code facilement extensible, je vous conseille l'approche ci-dessous. Elle permet de garder le code de positionnement de la forme "générique" pour toutes les formes, et l'ajout d'un nouveau cas (par exemple cellule = 3 → faire un rond) plus facile sans rallonger le code.

Dim maForme As Shape
For x = 1 To 8
    Select Case Cells(1, x).Value
    Case 1
        Set maForme = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 40, 40, 40, 40)
    Case 2
        Set maForme = ActiveSheet.Shapes.AddShape(msoShapeOval, 40, 40, 27, 40)
    Case Else
        Set maForme = Nothing
    End Select

    If Not(maForme Is Nothing) Then
        With maForme
            .Name = ("figure " & x)
            .Top = Cells(5, x).Top + (Cells(5, x).Height - .Height) / 2
            .Left = Cells(5, x).Left + (Cells(5, x).Width - .Width) / 2
        End With
    End If
Next x