Grouper des images

Version imprimable

08/02/2010, 14h28
patyom

Grouper des images
Bonjour,
J'ai besoin de grouper une dizaines d'images ("PictureNNN") dans une feuille en code VBA.
Je tourne en rond depuis un petit moment alors je viens demander à quelqu'un s'il a déjà fait.
J'ai récupéré le code suivant:
Code:

1 2 3 ActiveSheet.Shapes.Range(Array("Picture 511", "Picture 512", "Picture 513")).Select Selection.ShapeRange.Group
mais il faut que je remplace ce qui se trouve dans "array(...)" par je ne sais pas quoi ?
:oops:
A+
08/02/2010, 16h04
Invité

Bonjour

Peux-tu être un peu plus clair,car à priori tu as trouvé le code que tu veux, alors qu'est-ce qui bloque :koi:

Philippe

oui pardon,
Moi qui suis dessus je ne me rends pas compte.
Voilà, j'ai dans ma feuille des pictures déjà crées mais je ne connais pas leurs noms (j'ai mis ""Picture 511", "Picture 512",.. " comme exemple) donc j'ai créé le code qui suit pour les récupérer :
Code:

1 2 3 4 5 6 7 8 9 10 Dim MyArray(10) as string ' Sélection des Picture seules ' ************************************************************ If img.Name Like "Picture*" Then i = i + 1 MyArray(i) = img.Name End If
et c'est là que ça coince car il n'accepte pas ce code :
Code:

1 2 ActiveSheet.Shapes.Range(Array(MyArray(1) & "," & MyArray(2) & "," & MyArray(3) & "," & MyArray(4))).Select Selection.ShapeRange.Group.Select
J'espère que c'est plus clair

A+

08/02/2010, 17h36
Invité

Ok

Je ne connais pas Excel pour Mac, mais il y a le moyen de voir le nom des objets, mais sur les versions 2002 de Excel, on peut avoir une icone dans la barre de dessin qui se nomme "Sélectionnez les objets", elle permet de voir les noms.

Cependant, on la trouve dans les menus personnalisés car elle n'est pas affichée tout de suite, il faut regarder dans la barre d'outils dessin du menu personnalisé et la glisser dans ta barre d'outil.

Philippe

Bonjour,

Une réponse un peu tardive, mais elle peut être utile.
En fait il ne faut pas se prendre trop la tête, chez moi j'ai utilisé :

Code:

1
2
   ActiveWindow.Selection.SlideRange.Shapes.Range(MyArray).Select
   ActiveWindow.Selection.ShapeRange.Group.Select

et pour ceux que cela intéresse, l'ensemble du code est ici :

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
Sub liste_image()
 
Dim MyArray(10) As String
 
    Nbobjet = ActiveWindow.Selection.SlideRange.Shapes.Count
    Text_Objet = " objets dans la planche"
    If Nbobjet = 1 Then Text_Objet = " objet dans la planche"
    MsgBox ("Il y a " & Nbobjet & Text_Objet)
 
 
    ' Boucle de lecture des objets de la planche
    For Iobjet = 1 To Nbobjet
        ActiveWindow.Selection.SlideRange.Shapes(Iobjet).Select
        Set Ma_Shape = ActiveWindow.Selection.SlideRange.Shapes(Iobjet)
        ObjetName = Ma_Shape.Name
        ObjetType = Ma_Shape.Type
        ObjetTop = Ma_Shape.Top
        ObjetLeft = Ma_Shape.Left
        ObjetWidth = Ma_Shape.Width
        ObjetHeight = Ma_Shape.Height
            T_ecr = "L_objet   : " & L_objet & Chr(13) & _
                    "Objet     : " & Iobjet & Chr(13) & _
                    "Nom       : " & ObjetName & Chr(13) & _
                    "Type      : " & ObjetType & Chr(13) & _
                    "Top       : " & ObjetTop & Chr(13) & _
                    "Left      : " & ObjetLeft & Chr(13) & _
                    "Width     : " & ObjetWidth & Chr(13) & _
                    "Height    : " & ObjetHeight & Chr(13)
            MsgBox T_ecr
 
 ' Sélection des Picture seules
' ************************************************************
        If ObjetName Like "Picture*" Then
             i = i + 1
            MyArray(i) = ObjetName
        End If
 
    Next
 
 
   ActiveWindow.Selection.SlideRange.Shapes.Range(MyArray).Select
   ActiveWindow.Selection.ShapeRange.Group.Select
End Sub

A+
PPz

bonjour patyom et à tous,

voici une autre solution possible,

Code:

1
2
3
4
5
6
7
Sub GroupePicture()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
If Left(Shp.Name, 4) = "Pict" Then Shp.Select Replace:=False
Next
Selection.ShapeRange.Group
End Sub