Bonjour
bon j'ai commencé un truc mais j'avoue... je jette l'éponge...
il y a trop de choses qui ne vont pas...
il y a des photos qui sont regroupées avec des formes.. avec des sous groupes..... => groupe 27-> groupe 28 -> groupe 30 pour potentiellement prendre l'image 33 celle-là j'ai même pas essayé de la récupérer.
ensuite c'est pour récupérer le nom... il faudrait maintenant rechercher la position de l'elipse pour savoir si elle est sur l'image pour pouvoir construire les noms de sauvegarde : photo 2= 10_A ; photo 3 = 10_B ; photo 4 = 10_C ; photo 5 = 10_D
ci dessous un début de proposition... mais j'arrêté la.. cela fait l'export des photos avec un redimensionnement (a modifier si nécessaire) de la feuille active...
le nom de la photo est celui de l'image dans Excel. et se trouve dans le même dossier où se trouve le fichier exécutant le code..
Sub EXPORT()
Dim i As Integer
i = 1
For Each shp In ActiveSheet.Shapes
If LCase(Left(shp.Name, 3)) = "pic" Or LCase(Left(shp.Name, 3)) = "ima" Then
Select Case (Split(shp.Name, " ")(1))
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 16, 31, 45, 99
Case Else
If shp.Width > 50 Then Debug.Print shp.Name: enregistrement_shape shp.Name, i: i = i + 1
End Select
End If
Next
End Sub
Sub enregistrement_shape(nom As String, nb As Integer)
ActiveSheet.Shapes(nom).Copy
Set oDia = ActiveSheet.ChartObjects.Add(0, 0, 1000, 1000)
Set oChartArea = oDia.Chart
oDia.Activate
With oChartArea
.ChartArea.Select
.Paste
Selection.ShapeRange.Height = 1000
Selection.ShapeRange.Width = 1000
.EXPORT Filename:=ThisWorkbook.Path & "\" & [A5] & "_" & nb & ".jpg", FilterName:="jpg"
End With
oDia.Delete
End Sub
voici un aperçu du résultat :
Fred