Créer des formes rectangulaire en fonction d'un tableau

Bonjour la communauté,

Je souhaiterais pouvoir créer automatiquement des rectangles en fonction de mes données du tableau, en reprenant la désignation pour l'inscrire dans le ou les rectangle(s) créé(s).

Bonjour,

Une piste à adapter à tes besoins :

Sub Test()

    Dim Rect As Shape
    Dim Plage As Range
    Dim Cel As Range
    Dim Largeur As Integer
    Dim Longueur As Integer
    Dim Haut As Long
    Dim Gauche As Integer
    Dim I As Integer

    'supprime tous les rectangles
    For Each Rect In ActiveSheet.Shapes: Rect.Delete: Next Rect

    'défini la plage seulement sur les cellules non vides de la zone
    Set Plage = Range("A3:C24").Cells.SpecialCells(xlCellTypeConstants)

    'position, à adapter
    Gauche = 300
    Haut = 10

    For Each Cel In Plage

        'récup des tailles
        Longueur = Trim(Split(Cells(2, Cel.Column).Value, "X")(0))
        Largeur = Trim(Split(Cells(2, Cel.Column).Value, "X")(1))

        'création et paramétrage
        For I = 1 To Cel.Value

            Set Rect = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)

            With Rect

                .Width = Longueur / 10
                .Height = Largeur / 10
                .Left = Gauche
                .Top = Haut
                Haut = Haut + .Height + 10
                .TextFrame.Characters.Text = Cells(Cel.Row, 4).Value
                .TextFrame.Characters.Font.ColorIndex = 3
                .Fill.ForeColor.RGB = RGB(100, 200, 200)
                .TextEffect.FontBold = msoCTrue
                .TextEffect.FontSize = 20

            End With

        Next I

    Next Cel

End Sub

Bonjour Theze,

merci pour cette piste, je l'explore et te tiens informé.

Bonjour Theze,

Parfait cela répond à ma demande.