Créer des shapes groupés

Bonjour,

Je veux compléter le code suivant pour que les deux shapes soient directement groupés

merci d'avance

Set myArchg = ActiveSheet.Shapes.AddShape(msoShapeArc, x + r1, y, r1, r2)

myArchg.Adjustments(1) = 180
myArchg.Adjustments(2) = -90
myArchg.Line.ForeColor.RGB = RGB(a, 0, 0)
myArchg.Line.Weight = 0.01
myArchg.Name = "c"

Set Lhh = ActiveSheet.Shapes.AddLine _
(x + r1, y, x + lc - r1, y)

Lhh.Line.ForeColor.RGB = RGB(a, 0, 0)
Lhh.Line.Weight = 0.01
Lhh.Name = "c"

Bonjour,

Je suggère de nommer les 2 shapes initiaux avec des noms différents pour que le code soit le plus simple possible =>

Dim Sh As Shape

    With ActiveSheet
        With .Shapes.AddShape(msoShapeArc, x + r1, y, r1, r2)
            .Adjustments(1) = 180
            .Adjustments(2) = -90
            .Line.ForeColor.RGB = RGB(a, 0, 0)
            .Line.Weight = 0.01
            .Name = "c1"
        End With

        With ActiveSheet.Shapes.AddLine(x + r1, y, x + lc - r1, y)
            .Line.ForeColor.RGB = RGB(a, 0, 0)
            .Line.Weight = 0.01
            .Name = "c2"
        End With

        Set Sh = .Shapes.Range(Array("c1", "c2")).Group
        Sh.Name = "Groupe_machin"
    End With

Pierre

Bonjour,

Merci pour la réponse hélas, me dit ça:

image

Cordialement

Bonjour,

Voir fichier démo fonctionnel avec le code proposé =>

Pierre

Rechercher des sujets similaires à "creer shapes groupes"