Aligner rectangle

Bonjour,

J'aimerais aligner 5 rectangles dans 6 cellules (la largeur totale des 5 rectangles = largeur des 6 cellules). Mais mes 5 rectangles se mettent directement dans les 5 premières cellules et ce chevauchent alors que j'aimerais qu'ils soit tous cote à cote. Est-ce possible? Le but final est d'arriver au résultat entouré en rouge ci-dessous (que j'ai obtenu en faisant un copier collé). Les formes en bleu est le resultat actuel

j'ai utilisé le code ci-dessous

X = ActiveCell.Row                  ' définit la ligne de la cellule active
Y = ActiveCell.Column               ' définit la colonne de la cellule active
For L = X To X          ' 7 rectangles en X de 5 lignes de haut
    For C = Y To Y + 4           ' 9 rectangles en Y
        With Range(Cells(L, C), Cells(L, C + 6))
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, 37, .Height).Select
           ActiveSheet.Shapes.SelectAll

        End With
    Next C
Next L

Merci par avance

Bonjour,

J'ai pas tout compris l'objectif final mais j'écrirai un truc du genre :

Dim R As Range, Sh As Shape

    With ActiveSheet
        For Each R In .Range(Selection.Address)
            Set Sh = .Shapes.AddShape(msoShapeRectangle, R.Left + (R.Width - 37) / 2, R.Top, 37, R.Height)
        Next R
    End With

Pierre

Genial, c'est exactement le résultat voulu !!

Merci beaucoup

Autre petite question, je viens de voir que je n'ai pas nommé mes shapes. J'aimerais les nommer Shape1, Shape2, Shape3...

J'ai essayer

Selection.ShapeRange.Name = "Shape1"+1

Mais ça ne marche pas :/.

Auriez-vous pas hasard une idée de comment faire ?

Bonjour,

Pour nommer les shapes, on peut utiliser l'objet Sh :

Dim R As Range, Sh As Shape, i As Integer

    With ActiveSheet
        For Each R In .Range(Selection.Address)
            Set Sh = .Shapes.AddShape(msoShapeRectangle, R.Left + (R.Width - 37) / 2, R.Top, 37, R.Height)
            i = i + 1
            Sh.Name = "blabla" & i
        Next R
    End With

Pierre

Bonjour Pierrep56,

Merci pour ton retour mais si j'utilise cette méthode, tous les rectangles créés via la macro portent le nom blabla1 et non blabla1, blabla2 :/

?? Sur mon PC avec le code proposé, j'ai bien blabla1, blabla2, ...

J'ai essayé de l'integrer à mon code de base mais pas de resultat :/

J'aimerai conserver mon code de base car j'en ai besoin dans plusieurs cas de figure

x = ActiveCell.Row               ' définit la ligne de la cellule active
y = ActiveCell.Column           ' définit la colonne de la cellule active
i = i + 1
Set Sh = .Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
For L = x To x + 5              ' 8 est le nombre de rectangles en X
    For C = y To y + 5          ' 5 est le nombre de rectangles en Y
        With Cells(L, C)
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
            Selection.ShapeRange.ShapeStyle = msoShapeStylePreset1
            Sh.Name = "blabla" & i

        End With

    Next C
Next L

Rien n'est bon dans ces lignes, et ça ne peut pas bien fonctionner.

En revanche, le code que je propose est parfaitement fonctionnel.

Il y a peut être des choix à faire ...

Pour la suite, c'est sans moi.

Merci d'avoir essayer en tout cas

Bonne journée