indexs dans collection pictures incohérents

[patricktoulon]

bonjour a tous
j'ai un soucis avec pictures
cette petite boucle me liste mêmes les bouton activX et toutes shapes confondues
alors que je n'ai qu'une seule image

Sub test()
    With ActiveSheet
        For i = 1 To .Pictures.Count
            MsgBox .Pictures(i).Name
        Next
    End With

End Sub

c'est un peu gênant

Résumé et résolution adoptée pour cette longue discussion

la collection pictures intégrant tout le oléobjects y compris les activeX
on est obligé de faire une boucle et de créer un range de shapes de type (13)msopicture
il y donc 2 solutions simples

Laurent en post91 qui la créé en selectionnant tout les shapes concernées
moi en post95 qui le cree avec un tableau de noms d'images

 

[patricktoulon]

re
@sylvanu
"du vrai n'importe quoi" c'est pas pour toi mais ces deux collections

Les fonctions Shape et Picture ne font pas la même chose.

non ici on parle de shapes et pictures (avec le "s" ) qui sont des collections
et non shape et picture qui sont des object

 

[sylvanu]

Un oubli orthographique ne conduit pas à une incompréhension du problème.
Regardez mon code :

    Cells(i, 2) = ActiveSheet.Pictures(i).Name
    
    Cells(i + 7, 2) = ActiveSheet.Shapes(i).Name

Avec évidemment des "s". J'avais compris qu'on parlait de collections !
Même si je suis nul, j'arrive à vous suivre. tout du moins j'essaie.

 

[patricktoulon]

@silvanu
pour compléter mon constat
ta boucle shapes ne liste pas le rectangle 15
donc la je pige plus du tout

ya pas un bug la dans ces deux objects collection ?????????????????

 

[patricktoulon]

bon ben visiblement il n'y a rien a faire avec ces collections
visiblement seule la collection OLEObjects reste fidèle a sa fonction

 

[sylvanu]

C'est fantastique, c'est ce que je me borne à vous expliquer.

  Cells(i, 2) = ActiveSheet.Pictures(i).Name
  Cells(i + 7, 2) = ActiveSheet.Shapes(i).Name

Ces deux lignes de code ne font pas la même chose.
Pictures et Shapes ne référence pas les mêmes collections.
Shapes ne référence pas les Formes alors que Pictures les référence.
Et il n'y a aucun bug dans ces collections. d'ailleurs lequel ?
Faites l’exercice, dans une feuille mettez des ActiveXObjects, des images et des Formes libres.
Et vous obtiendrez le même résultat.

 

[Staple1600]

Re

Moi, je ne vois que des Shapes

Sub ChapiChapo()
Dim Shp As Shape, i&
[A1:D1] = [{"TypeName Shape", "Nom Shape", "AutoShapeType", "Type"}]
i = 2
  For Each Shp In ActiveSheet.Shapes
    Cells(i, 1).Resize(, 4) = Array(TypeName(Shp), Shp.Name, Shp.AutoShapeType, Shp.Type)
  i = i + 1
  Next
[A1].CurrentRegion.Columns.AutoFit
End Sub

PS: faute de grives, je mange des merles
Sinon je ne serai pas là

 

[patricktoulon]

re

Et il n'y a aucun bug dans ces collections. d'ailleurs lequel ?

ben par exemple ta liste shapes qui prend pas le rectangle 15
et la liste shapes de Staple qui elle le liste

je raconte pas de sottise bon sang !!
pourtant vous bouclez sur la même collection ("shapes")

 

[sylvanu]

Soit, mais où se trouve l'erreur dans cette ligne de code ?

Cells(i + 7, 2) = ActiveSheet.Shapes(i).Name

Par contre la macro de Staple permet de lever l’ambiguïté en utilisant le Type du shape puisqu' apparemment une image est de type 13, une forme de type 1 et un ActiveXobject de type 12.
Pour en revenir à votre post #1, cela résoudrait le problème.

 

[patricktoulon]

re

Shapes ne référence pas les Formes alors que Pictures les référence.

heu...................................................... c'est plutot l'inverse


ben l'erreur c'est pas inversé par hasard

pas ca

Sub liste()
' Liste les Pictures
nombre = ActiveSheet.Pictures.Count
For i = 1 To nombre
    Cells(i , 2) = ActiveSheet.Pictures(i).Name
Next i

' Liste les Shapes
nombre = ActiveSheet.Shapes.Count
For i = 1 To nombre
    Cells(i+ 7, 2) = ActiveSheet.Shapes(i).Name
Next i
End Sub

mais plutot ca

Sub liste()
' Liste les Pictures
nombre = ActiveSheet.Pictures.Count
For i = 1 To nombre
    Cells(i + 7, 2) = ActiveSheet.Pictures(i).Name
Next i

' Liste les Shapes
nombre = ActiveSheet.Shapes.Count
For i = 1 To nombre
    Cells(i, 2) = ActiveSheet.Shapes(i).Name
Next i
End Sub

et moi je pleure la misère a essayer de te comprendre depuis toute a l'heure

donc conclusion
collection shapes
liste tout d'abords shape et picture confondue dans l'ordre de création
et ensuite les oleobject de la collection oleobjects dans l'ordre de création

collection pictures
liste d'abords les oleobject de la collection oleobjects dans l'ordre de création
ensuite les images(picture) dans l'ordre de création
ne liste pas les formes automatiques

bon ben avec ca je sais pas ou on va mais on y va

et je vais meme plus loin dans mon investigation
le fait de boucler "for each" ou "for i = 1 to X"
shp et shape(i) ne sont pas des même objects et dans la boucle i ça déclenche une erreur

démonstration avec le code de Staple1600 modifié

Sub ChapiChapo()
Dim Shp As Shape, i&

[A1:D1] = [{"TypeName Shape", "Nom Shape", "AutoShapeType", "Type","index ordre"}]
'****************************************************
'methode Staple1600 fonctionne
'i = 2
  'For Each Shp In ActiveSheet.Shapes
    'Cells(i, 1).Resize(, 4) = Array(TypeName(Shp), Shp.Name, Shp.AutoShapeType, Shp.Type, Shp.Index)
  'i = i + 1
  'Next
'********************************************************


'*********************************************************
'cette mehode de boucle déclenche une erreur je ne sais pas pourquoi
For i = 1 To ActiveSheet.Shapes.Count
Cells(i + 1, 1).Resize(, 4) = Array(TypeName(Shapes(i)), Shapes(i).Name, Shapes(i).AutoShapeType, Shapes(i).Type, i)
Next
'**********************************************************

[A1].CurrentRegion.Columns.AutoFit
End Sub

 

[sylvanu]

Pour en revenir au post #1, ce code semble marcher. Il ne liste que les images.

Sub Test()
For Each Shp In ActiveSheet.Shapes
    If Shp.Type = 13 Then
        MsgBox Shp.Name
    End If
Next
End Sub

 

[Staple1600]

Bonjour à toi aussi Sylvanu...

(cf message#25)

 

[patricktoulon]

Pour en revenir au post #1, ce code semble marcher. Il ne liste que les images.

Sub Test()
For Each Shp In ActiveSheet.Shapes
    If Shp.Type = 13 Then
        MsgBox Shp.Name
    End If
Next
End Sub

oui l'inconvénient finalement est de devoir boucler sur des object différents pour chopper le seul qui a un type picture

avez vous regardé le code modifié de Staple1600
à celui qui arrive a m'expliquer
y aurait il une surcouche dans cette collection"shapes"

 

[Staple1600]

Re

=>patricktoulon
Il suffit d'un point

Sub ChapiChapo_II()
Dim shp As Shape, I&
[A1:E1] = [{"TypeName Shape", "Nom Shape", "AutoShapeType", "Type","NB"}]
With ActiveSheet
For I = 1 To .Shapes.Count
Cells(I + 1, 1).Resize(, 5) = Array(TypeName(.Shapes(I)), .Shapes(I).Name, .Shapes(I).AutoShapeType, .Shapes(I).Type, I)
Next
End With
[A1].CurrentRegion.Columns.AutoFit
End Sub

 

[laurent950]

Bonjour Patrick,
Voila ce code qui peux avoir un certain interet :
Site : http://www.pptfaq.com/FAQ00008_Show_the_-Type_of_each_shape_-including_shapes_in_groups-.htm
Les différents types :
site : https://docs.microsoft.com/fr-fr/office/vba/api/office.msoshapetype

' Shyam Pillai, Brian Reilly & Steve Rindsberg
Sub Object_Types_on_This_Slide()
    'Refers to each object on the current page and returns the Shapes.Type
    'Can be very useful when searching through all objects on a page
    Dim it As String
    Dim i As Integer
    Dim Ctr As Integer
    '''''''''''''''''
    'Read-only  Long
    '''''''''''''''''
    For i = 1 To ActiveSheet.Shapes.Count  'ActiveWindow.Selection.SlideRange.Shapes.Count
        'No need to select the object in order to use it
        With ActiveSheet.Shapes(i) 'ActiveWindow.Selection.SlideRange.Shapes(i)

        'But it is easier to watch when the object is selected
        'This next line is for demonstration purposes only.
        'It is not necessary
        'ActiveWindow.Selection.SlideRange.Shapes(i).Select
        ActiveSheet.Shapes(i).Select

        Select Case .Type

            'Type 1
            Case msoAutoShape
                it = "an AutoShape. Type : " & .Type

            'Type 2
            Case msoCallout
                it = "a Callout. Type : " & .Type

            'Type 3
            Case msoChart
                it = "a Chart. Type : " & .Type

            'Type 4
            Case msoComment
                it = "a Comment. Type : " & .Type

            'Type 5
            Case msoFreeform
                it = "a Freeform. Type : " & .Type

            'Type 6
            Case msoGroup
                it = "a Group. Type : " & .Type

            ' If it's a group them iterate thru
            ' the items and list them

                it = it & vbCrLf & "Comprised of..."
                For Ctr = 1 To .GroupItems.Count
                    it = it & vbCrLf & _
                        .GroupItems(Ctr).Name & _
                        ". Type:" & .GroupItems(Ctr).Type
                Next Ctr

            'Type 7
            Case msoEmbeddedOLEObject
                it = "an Embedded OLE Object. Type : " & .Type

            'Type 8
            Case msoFormControl
                it = "a Form Control. Type : " & .Type

            'Type 9
            Case msoLine
                it = "a Line. Type : " & .Type

            'Type 10
            Case msoLinkedOLEObject
                it = "a Linked OLE Object. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                        .SourceFullName
                End With

            'Type 11
            Case msoLinkedPicture
                it = "a Linked Picture. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                        .SourceFullName
                End With

            'Type 12
            Case msoOLEControlObject
                it = "an OLE Control Object. Type : " & .Type

            'Type 13
            Case msoPicture
                it = "a embedded picture. Type : " & .Type

            'Type 14
            Case msoPlaceholder
                it = "a text placeholder (title or regular text--" & _
                     "not a standard textbox) object." & _
                     "Type : " & .Type

            'Type 15
            Case msoTextEffect
                it = "a WordArt (Text Effect). Type : " & .Type

            'Type 16
            Case msoMedia
                it = "a Media object .. sound, etc. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & " My Source: " & _
                    .SourceFullName
                End With

            'Type 17
            Case msoTextBox
                it = "a Text Box."

            'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
            'Case msoScriptAnchor
            Case 18
                it = " a ScriptAnchor. Type : " & .Type

            'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
            'Case msoTable
            Case 19
                it = " a Table. Type : " & .Type

            'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
            'Case msoCanvas
            Case 20
                it = " a Canvas. Type : " & .Type

            'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
            'Case msoDiagram
            Case 22
                it = " a Diagram. Type : " & .Type

            'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInk
            Case 22
                it = " an Ink shape. Type : " & .Type

            'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInkComment
            Case 23
                it = " an InkComment. Type : " & .Type

            'Type -2
            Case msoShapeTypeMixed
                it = "a Mixed object (whatever that might be)." & _
                     "Type : " & .Type

            'Just in case
            Case Else
                it = "a mystery!? An undocumented object type?" & _
                        " Haven't found one of these yet!"
        End Select

        MsgBox ("I'm " & it)
        End With
    Next i
End Sub

Je sais pas si cela peut t'aider mais je trouve qu'il est assez ineteressant

laurent

 

[Staple1600]

Décidément...

Bonjour aussi à toi laurent950...

[Pour infos]
=>laurent950
Le lien sur msoShapeType est déjà dans le fil
(fourni par jmfmarques =>message#4)
[/Pour infos]