indexs dans collection pictures incohérents

patricktoulon

XLDnaute Barbatruc
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 :oops: o_O
VB:
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
 
Dernière édition:
Solution
Re,
Partie 2
Comment Travailler avec Chaques images stockés de la feuille Excel dans la variable Objet "sr"
Avec une Boucle Ou juste sur une précise (J'ai choisie juste une précise est désactivé la boucle)
Pour Travailler avec les images :
https://docs.microsoft.com/fr-fr/office/vba/api/excel.pictureformat
Méthodes
Propriétés
Code...

laurent950

XLDnaute Accro
Sub Macro1() ActiveSheet.Pictures.Insert("C:\Users\STAPLE\Pictures\test.jpg").ShapeRange.Name = "TOTO" MsgBox TypeName(ActiveSheet.Shapes("TOTO")) End Sub
Oui Staple mais en message poste #11 tu insert une image, mais en fait Patrick avait déjà cette image dans la Feuille excel:

c'est a dire qu'il n'a pas besoin du chemin pour insérer cette image puisqu'elle existe déjà dans sa feuille
Donc l'autre méthode est de stocker dans l'objet Shape une image existante :

ton idée du poste #11 serait plutot décomposée en 2 temps comme le programme ci dessous :
comme tu inserts : C:\Users\STAPLE\Pictures\test.jpg il y a besoin d'une image stocké sur un disk et non existant dans la feuille excel.
VB:
' https://www.tutoderien.com/travailler-avec-des-images-en-vba/#Rechercher_une_image
Sub ImageImportDepuisDisk()
Dim ImageFile As FileDialog
'
Set ImageFile = Application.FileDialog(msoFileDialogFilePicker)

With ImageFile
    .Title = "Selectionner une image"
    .Filters.Add "All Picture Files", "*.jpg, *.jpge, *.gif, *.png, *.gif, *.bmp, *.tiff", 1
        If .Show <> -1 Then
            GoTo Vide
        End If
    Sheets(1).Range("A1") = .SelectedItems(1) ' Placer le lien de l'image en A1
End With

AfficheImage

Vide:
End Sub
VB:
Sub AfficheImageEtModifie()
Dim ImageLien As String
'
With Sheets(1)
    On Error Resume Next
        .Shapes("MonImage").Delete
    On Error GoTo 0
'
ImageLien = .Range("A1") 'Lien de l'image
'
' si pas de lien alors on ne fait rien
    If ImageLien = Empty Then
        Exit Sub
    End If
'
Dim Imag As Shape
' Si une image sur la feuille = Array(1)
' ActiveSheet.Shapes.Range(Array(1)).Select
' suite si on veux stocké cette image dans un objet
' donc:  Set shCG = ActiveSheet.Shapes.AddPicture(Filename:=strConcat, _
'                                                    linktofile:=msoFalse, _
'                                                    savewithdocument:=msoTrue, _
'                                                    Left:=1400, _
'                                                    Top:=0, _
'                                                    Width:=450, _
'                                                    Height:=600)
    With .Pictures.Insert(ImageLien)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Height = 179
            .Width = 179
            .Name = "MonImage"
        End With
    End With
' Stock l'image dans l'objet
   Set Imag = ActiveSheet.Shapes(ActiveSheet.Shapes.Range(Array("MonImage")).Name)
            With Imag '.Shapes("MonImage")
            .Left = 10
            .Top = 179
            .IncrementLeft 17
            .IncrementTop 10
        End With
End With
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil

laurent950
Je suis resté sur cette problématique "finale"
et enfin une SEULE !! picture qui est insérer(pictures.insert) /delétée dynamique autant de fois que je clique sur bouton
D'où la suggestion du post#11 : nommer l'image qu'on insère
Et la macro du post#11 n'était que l'illustration de la suggestion
Enfin le renvoi au post#43 c'était pour t'aiguiller pour répondre à ta question de connaitre la position d'une image.
PS: patricktoulon n'a jamais parlé de stocké son image sur la feuille.
Donc à mon sens (et dans la configuration de cette question), une seule ligne de code suffit pour savoir où est l'image sur la feuille.
(C'est ce que tentait d'illustrer le message#11)
J'ai remanié à peu le code.
Ci-dessous deux variantes d'écriture.
VB:
Sub Macro1()
Dim imgPath$
imgPath = "C:\Users\STAPLE\Pictures\test.jpg"
On Error Resume Next
ActiveSheet.Shapes("TOTO").Delete
With ActiveSheet.Pictures.Insert(imgPath)
.ShapeRange.Name = "TOTO"
MsgBox .TopLeftCell.Address 'exemple 1
End With
MsgBox ActiveSheet.Shapes("TOTO").BottomRightCell.Address 'exemple 2
End Sub
VB:
Sub Macro2()
Dim Shp As Shape, Pic As Picture, imgPath$
imgPath = "C:\Users\STAPLE\Pictures\test.jpg"
On Error Resume Next
ActiveSheet.Shapes("TOTO").Delete
Set Pic = ActiveSheet.Pictures.Insert(imgPath): Pic.Name = "TOTO"
Set Shp = ActiveSheet.Shapes("TOTO")
MsgBox Shp.TopLeftCell.Address 'exemple 1
MsgBox Shp.BottomRightCell.Address 'exemple 2
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Comme il pleut par ici, j'ai pris le temps de relire tout le fil
Et avant le message#11, il y avait le message#6 (de job75)
Par conséquent, on pourrait ne pas être à la page 4 et à plus de 60 posts dans ce fil, non ? ;)
VB:
Sub last_test()
Dim imgPath$: imgPath = "C:\Users\STAPLE\Pictures\test.jpg"
On Error Resume Next
With ActiveSheet
.Shapes(.Pictures(.Pictures.Count).Name).Delete: .Pictures.Insert (imgPath)
End With
End Sub
 

laurent950

XLDnaute Accro
Bonjour Staple,
on peut dire que ces #67 postes auront fait une bonne révision de l'objet Shape... Alors on ne pourra plus dire qu'il y a quelque chose qui m'é-SHAPE :p :p maintenant. Je te remercie Staple1600 pour toutes tes informations très précieuses aussi, un grand merci à toi.
Laurent
 

patricktoulon

XLDnaute Barbatruc
bonjour
re
Par conséquent, on pourrait ne pas être à la page 4 et à plus de 60 posts dans ce fil, non ? ;)
il y a une différence entre proposer une alternative et répondre a la question dans son sens natif
;)
perso j'ai repris ma méthode Multi image
dimer en global un tablo(2dim) pour les pictures et les path et redim preserve (0 to x) lors du getopenfilename

2 variables ;)

pour la curiosité je ne désespère pas trouver un jour
la trouvaille de Laurent n'est pas mal au moins on les a dans l'ordre
ce qui permet au pire dans une boucle de la raccourcir au vrai count des pictures
 

Staple1600

XLDnaute Barbatruc
Re

[blagounette post-apéritif du dimanche]
il y a une différence entre proposer une alternative et répondre a la question dans son sens natif
;)
Tout comme il y a une différence entre index et indexs
(Ce dernier n'existe pas dans la langue française)
[/blagounette post-apéritif du dimanche]

NB: Il me semble avoir lu dans le 1er message que tu ne voulais pas boucler...
ce qui permet au pire dans une boucle de la raccourcir au vrai count des pictures
 

patricktoulon

XLDnaute Barbatruc
re
VB:
Function pictureX()
    Dim tablo() As Object
    Do
        i = i + 1
        Set p = ActiveSheet.Shapes(ActiveSheet.Shapes.Range(Array(i)).Name)
        If p.Type = 13 Then a = a + 1: ReDim Preserve tablo(1 To a): Set tablo(a) = p
    Loop While i < ActiveSheet.Shapes.Count Or p.Type = 13
    pictureX = tablo
End Function

Sub test1()
    Dim p
    p = pictureX
    Debug.Print "il y a " & UBound(p); " images(pictures)"
    For i = 1 To UBound(p)
        Debug.Print p(i).Name
    Next
End Sub

Sub test2()
MsgBox pictureX(5).Name
End Sub

me reste le transformer en tableau de picture et non de shapes
car j'ai essayé ce qui est bloqué et ça me renvoie les autre object alors que (p.name) o_O o_O o_O
 

patricktoulon

XLDnaute Barbatruc
re
puré...
Quel paramètre !!!!!!???????

la question initial était index incohérent car ça prenais les autres object

je veux pictures(1) qu'il y en ai 50 ou 1

une c'est parce que j'ai changé de fusil d’épaule mais la question reste la même
alors oui le .count me donne la dernière insérée mais au départ mon projet va de 1 a X images
et je peux revenir a la une comme a la 20eme


ça change rien du tout

les shapes liste tout avec shapes et pictures et controls dans cet ordre IL ME SEMBLE ;)
les pictures liste controls et autres oleobjects et images dans cet ordre

donc conclusion aucun des deux ne me donne la une en first position

l'astuce de Laurent oui car elle liste respectivement images,shape,controls dans cet ordre

MALHEUREUSEMENT ELLE NE S ARRÊTE pas A LA DERNIÈRE IMAGE
je trouverais bien ;)

sinon j'ai fait avec un tableau 2 dim object/path et ca marche
ca m'ennuie un peu car une image sur sheets est un bitmap et donc bien plus lourd que le JPG original de 200k à 5 ou 6 mega pour des jpeg de grande tailles (photo hi résolution)
c'est pour ça que j'aurais préféré appeler la collection par pictures ou mêmes shapes plutôt que d'avoir le paquet en mémoire dans une variables pour pas faire souffrir VBA et pas avoir une latence pendant la tentative l'acces
je vais voir si je peux stocker seulement les nom excel des images si ca modifie pas trop le reste du code

patience ;)

par contre je veux bien que tu m'explique le soucis avec la partie de remplacement en commentaire de mon dernier code si tu a la réponse ;)
 

laurent950

XLDnaute Accro
MALHEUREUSEMENT ELLE NE S ARRÊTE pas A LA DERNIÈRE IMAGE
je trouverais bien
C'est à dire que tu aimerais identité toutes les images sur la feuille Excel "Juste le format shapes = 13" et stocké c'est image dans un tableau sans prendre en compte les autres format "Il y a 31 groupes différents... mais ont peux repéré les 31 groupes "codes comme le code 13 qui correspond à une image" est les stocké dans un tableau pour chacun d entre eux. Je sais pas si j ai bien compris ton interrogation Patrick ?
 

patricktoulon

XLDnaute Barbatruc
C'est à dire que tu aimerais identité toutes les images sur la feuille Excel "Juste le format shapes = 13" et stocké c'est image dans un tableau sans prendre en compte les autres format "Il y a 31 groupes différents... mais ont peux repéré les 31 groupes "codes comme le code 13 qui correspond à une image" est les stocké dans un tableau pour chacun d entre eux. Je sais pas si j ai bien compris ton interrogation Patrick ?

juste les images
sans boucle avec ton astuce tu peux faire un tableau de pictures ??????
 

patricktoulon

XLDnaute Barbatruc
re
voila mon soucis avec ta methode

regarde bien la différence avec picturex2 et picturex2

je veux un tableau de pictures pas de shapes
car avec les object en tant que shapes dans le tableau , je n'ai pas acces au propriété et méthodes pictures

et la picturex2 est completement loufoque ;)

VB:
Option Explicit
Function pictureX1()
    'tableau des pictures en object shapes
    Dim tablo() As Object, I&, P As Shape, A&
    Do
        I = I + 1
        Set P = ActiveSheet.Shapes(ActiveSheet.Shapes.Range(Array(I)).Name)
        If P.Type = 13 Then A = A + 1: ReDim Preserve tablo(1 To A): Set tablo(A) = P
    Loop While I < ActiveSheet.Shapes.Count Or P.Type = 13
    pictureX1 = tablo
End Function

Sub test1()
    Dim P, I&
    P = pictureX1
    Debug.Print "il y a " & UBound(P); " images(pictures)"
    For I = 1 To UBound(P)
        Debug.Print P(I).Name
    Next
End Sub

Sub test2()
MsgBox pictureX1(5).Name
End Sub



'******************************************************************************************


'avec ce qui suit c'est incoherent

Function pictureX2()
    'tableau des pictures en object pictures
     Dim tablo() As Object, I&, P As Shape, A&
   Do
        I = I + 1
        Set P = ActiveSheet.Shapes(ActiveSheet.Shapes.Range(Array(I)).Name)
        If P.Type = 13 Then A = A + 1: ReDim Preserve tablo(1 To A): Set tablo(A) = ActiveSheet.Pictures(P.Name)
    Loop While I < ActiveSheet.Shapes.Count Or P.Type = 13
    pictureX2 = tablo
End Function
Sub test3()
Dim P, I&
    P = pictureX2
    Debug.Print "il y a " & UBound(P); " images(pictures)"
    For I = 1 To UBound(P)
        Debug.Print P(I).Name
    Next

End Sub

en shapes j’arrête bien le tableau aux pictures mais en shapes
par contre la picturex2 malgré que j'entre dans le tableau des pictures avec le nom p.name
ça me sort n'importe quoi a la fin

encore mieux mort de rire avec le meme fichier
VB:
Sub test4()
MsgBox ActiveSheet.Pictures("Image 1").Name
End Sub

la si vous me dites qu'il n'y a pas de bug ;)
Bon j'ai beau tout essayer c'est bien la collection pictures qui est en vrac

un autre test encore plus rigolo (jaune)
VB:
Sub test4()
 Dim tablo(100) As Object, I&, P As Shape, A&
  For Each elem In ActiveSheet.Shapes
If elem.AutoShapeType = 1 Then A = A + 1: Set tablo(A) = ActiveSheet.Pictures(elem.Name): MsgBox "tablo(" & A & ")=" & elem.Name
'If elem.Type = 13 Then Debug.Print elem.Name; "   "; elem.Type
Next
MsgBox "tablo(1)=" & tablo(1).Name
End Sub
si vous me dites que c'est moi je pète un cable
 

Pièces jointes

  • test pour Laurent.xlsm
    176.5 KB · Affichages: 4
Dernière édition:

laurent950

XLDnaute Accro
Bonsoir patrick,
j'ai trouvé mais il faut quand même une boucle pour attraper toutes les images qui correspondent au code 13 (les images)
Pour le reste j'ai fait c'est stocker soit dans mon exemple
Dans une variable Objet sr = qui comprend toutes les images plus autres instrctuctions
Dans sr = Les objets images correspondent au Item(1) / Item(2) etc
Donc je crée un tableau Dim TabSr(1 To 3) As Shape
Chacune de ses cases seront un Objet
set TabSr(1) = sr.Item(1)
L'avantage sera d'avoir dans se tableau TabSr les 3 Objets images et le +++
TabSr(1) . avec le point tous se qui vient derriére automatiquement cf ci-dessous
* TabSr(i).Select
* Debug.Print TabSr(i).Name
* Cells(i + 1, 1) = TabSr(i).Name
donc c'est pour l'image 1 / TabSr(1).Select
pour l'image 2 / TabSr(2).Select
Voila l'idée ensuite pour attraper Set sr = Selection.ShapeRange sans passé par une boucle j'ai pas encore réfléchit à cela.

Le code ci-dessous commenté
VB:
Sub CategorieShapeRange()
' * Site cidessous avec select case donc l'idée / Array(msoPicture)
' * https://www.oreilly.com/library/view/programming-excel-with/0596007663/re1326.html
'
' Feuille stocker dans un tableau uniquement les Shapes correspondant au image soit / Code (13) = constante (msoPicture)
    Dim ws As Worksheet
        Set ws = Worksheets(ActiveSheet.Name)
' Variable tableau Array avec le type en correspondance msoPicture
' soit TypeShape = Array(msoPicture)
' Lecture du tableau avec Debug.print soit : TypeShape(0) // Ont peux lire 13 MAIS PAS LA CONSATNTE msoPicture DANS CE TABLEAU
    Dim TypeShape As Variant
        TypeShape = Array(msoPicture)
' Les variables
' s pour tous les Shape (soit 31 types de Shapes différent cf ci-dessus pour le choix d'un seul des 31 types le code 13 soit 1 Type)
    Dim s As Shape
' sr pour stocker les sous catégorie soit en locurence le code 13 qui correspond au images
' sr c'est une variable objet qui contient des tableaux d'objet
    Dim sr As ShapeRange
' Ici un tableau ou je vais sortir chaque Shapes (Code 13) de sr pour les stoker dans un tableaux d'objet.
    Dim TabSr(1 To 3) As Shape
' Find each autoshape on the worksheet and build a list.
    For Each s In ws.Shapes
        If s.Type = TypeShape(0) Then ' Si l'objet correspond au code 13
            s.Select False            ' Je selectionne cette objet.
        End If
    Next
    ' Stockage dans une variables objet tous les shapes code 13 / soit les items en correspondance
        Set sr = Selection.ShapeRange  ' Comme chacun des objets est selectionnées je les stocks dans la variables objet (sr de type ShapeRange)
    ' deselection des images
        ws.Cells(1, 1).Select          ' Je selectionne une cellule pour deselectionner les images?
    ' Bonus pour lister les images et les compter (uniquement le code 13)
    ' Nombres d'images qui corespond au code 13 soit msoPicture
        ws.Range(ws.Cells(1, 1), ws.Cells(ws.Cells(65536, 1).End(xlUp).Row, 1)).ClearContents
        ws.Cells(1, 1) = "il y a " & sr.Count & " images qui corespond au code 13 soit msoPicture dans la feuil active : Liste ci-dessous : "
    ' Ici une boucle sur l'objet Sr qui contient 3 objets Shape dans (sr de type ShapeRange)
        For i = 1 To sr.Count          ' ici le nombres de shape en correspondances soit 3
            Set TabSr(i) = sr.Item(i)  ' Chacun des shape qui correspondent sont stoké dans une variable tableau / sr.Item(1) = un shape / sr.Item(2) = un autres shape... etc.
        Next i
    ' *****************************************************************************************************************************************************************
    ' pour test et comprendre
    ' ci dessous le tableau d'image en correspondance en code 13
    Debug.Print LBound(TabSr)
    Debug.Print UBound(TabSr)
    ' ici 3 images donc test sur l'image 2
        Debug.Print TabSr(2).Name ' Nom
        TabSr(2).Select
    ' Boucle sur toutes les images
    For i = LBound(TabSr) To UBound(TabSr)
        TabSr(i).Select
        Debug.Print TabSr(i).Name
        Cells(i + 1, 1) = TabSr(i).Name
    Next i
    ' deselection des images
    ws.Cells(1, 1).Select
End Sub
 

Pièces jointes

  • test pour Laurent.xlsm
    185.7 KB · Affichages: 4

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof