Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
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 😳😵
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
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
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
re
donc après test
Set Imag = ActiveSheet.Shapes(ActiveSheet.Shapes.Range(X).Name)
nous donne la même chose que shapes
sauf qu'on les a dans le vrai ordre de type
d’abords les pictures ensuite les shapes et le reste
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
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
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 😛😛 maintenant. Je te remercie Staple1600 pour toutes tes informations très précieuses aussi, un grand merci à toi.
Laurent
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
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) 😵😵😵
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 😉
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 ?
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 ?
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
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
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
