shape contient plusieurs autres shapes [Résolu]

[hebh]

Bonjour,

Pour trouver les shapes qui existent dans une feuille on peut faire:

Code :

1
2
3
4
5
6
 
Dim img As Object
 
For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
  msgbox img.Name
Next

Mais si un shape dans la feuille contient plusieurs autres shapes alors comment les trouver?


Merci

[patricktoulon]

bonsoir

une shapes ne peut pas contenir d'autre shapes
on parle ici de groupe

fait un peu de recherche dans la faq tu va trouver ton bonheur

au plaisir

[Theze]

Bonjour,

Voilà un petit exemple, à adapter bien entendu. Je ne l'ai pas re-testé depuis que je l'ai conçu pour un ancien post (je ne sais plus si c'était sur ce forum ?) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Sub GroupeShapes()
 
    Dim Fe As Worksheet
    Dim Tbl() As Shape
    Dim S As Shape
    Dim Groupe As Range
    Dim I As Integer
    Dim J As Integer
 
    'sur la feuille active
    Set Fe = ActiveSheet
 
    'parcour les shapes de la feuille
    For Each S In Fe.Shapes
 
        'si c'est un groupe
        If S.Type = msoGroup Then
 
            'les stocke dans un tableau
            For I = 1 To S.GroupItems.Count
 
                J = J + 1
                ReDim Preserve Tbl(1 To J)
                Set Tbl(J) = S.GroupItems(I)
 
            Next I
 
            'puis les dégroupe afin de les récupérer de façon individuelle
            Fe.Shapes(S.Name).Ungroup
 
            'ici, récupération des noms (à voir ce qu'il a lieu d'en faire ?)
            For I = 1 To UBound(Tbl)
 
                On Error Resume Next
                Debug.Print Tbl(I).Name
                'Tbl(I).ControlFormat.Value = 0 'exemple, modif de la valeur pour une case à cocher
 
            Next I
 
            On Error GoTo 0
 
            'regroupe
            Set Groupe = Fe.Shapes.Range(Tbl())
 
            Groupe.Group
 
            Erase Tbl
 
        End If
 
    Next
 
End Sub

Hervé.

[hebh]

Bonjour,

Merci beaucoup pour vos réponses.
Hervé j'ai essayé ta solution mais dans la feuille il ne détecte aucun groupe. En fait quand je cherche les shapes dans la feuille il m'affiche deux: Graphique 1 et Graphique 2
Mais j'ai une image (image 1) dans "graphique 2" que je veux la supprimer mais je n’ai pas pu le faire.

Merci

[Theze]

Bonjour,

Le code que je t'ai posté concerne des shapes qui peuvent être groupé mais comme je ne vois pas vraiment comment sont incorporés les shapes, le mieux est que tu poste ton classeur.

Hervé.

[hebh]

Ci-joint le classeur, j'ai "graphique 6" et "graphique 7" et je veux supprimé "picture 4".


Merci

[hebh]

enfin j'ai trouvé la solution:

Code :

1
2
ActiveSheet.ChartObjects("Graphique 6").Activate
 ActiveChart.Shapes.Range(Array("Picture 4")).Delete

Des fois on cherche des jours pour une solution de 2 seconde. Il fallait juste enregistrer un macro et lors de l'enregistrement je selectionne ce boutton et je le supprime et là j'ai le code



Merci Beaucoup de votre aide