Sub test()
With ActiveSheet
For i = 1 To .Pictures.Count
MsgBox .Pictures(i).Name
Next
End With
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:Sub Macro1() ActiveSheet.Pictures.Insert("C:\Users\STAPLE\Pictures\test.jpg").ShapeRange.Name = "TOTO" MsgBox TypeName(ActiveSheet.Shapes("TOTO")) End Sub
' 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
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
D'où la suggestion du post#11 : nommer l'image qu'on insèreet enfin une SEULE !! picture qui est insérer(pictures.insert) /delétée dynamique autant de fois que je clique sur bouton
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
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
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
il y a une différence entre proposer une alternative et répondre a la question dans son sens natifPar conséquent, on pourrait ne pas être à la page 4 et à plus de 60 posts dans ce fil, non ?
Tout comme il y a une différence entre index et indexsil y a une différence entre proposer une alternative et répondre a la question dans son sens natif
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
Ce qui change les paramètres de la question initiale.et enfin une SEULE !! picture qui est insérer(pictures.insert) /delétée dynamique autant de fois que je clique sur bouton
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 ?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 ?
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
Sub test4()
MsgBox ActiveSheet.Pictures("Image 1").Name
End Sub
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
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