Enregistrer une image depuis excel dans un fichier

[Résolu/Fermé]
Signaler
Messages postés
3
Date d'inscription
mercredi 30 mai 2018
Statut
Membre
Dernière intervention
31 mai 2018
-
Messages postés
221
Date d'inscription
jeudi 12 août 2010
Statut
Membre
Dernière intervention
5 juillet 2019
-
Bonjour à tous,

J'essaie de créer une macro afin de faire l'action suivante :

Repérer si une cellule dans une colonne fixe contient une photo/image
Si c'est le cas, je souhaite enregistrer la photo/image de cette cellule en jpg dans un fichier au chemin prédéfini et unique. Le nom de cette image doit être celui de la valeur de la cellule correspondante dans laquelle se trouve l'image.
Si la cellule ne contient pas d'image, alors je passe à la suivante.

J'ai joint un exemple pour que ce soit plus clair :
Dans la cellule A2, j'ai bien une image, je veux donc que celle-ci soit enregistrée dans mon fichier (chemin défini) sous le nom 1.
Ma macro passe les autres cellules jusqu'à ce qu'elle arrive en A7, elle enregistre alors l'image en A7 sous le nom 4667 en jpg.



Voilà j'espère que c'est clair, je débute en VBA et je bloque dès qu'il s'agit de travailler avec des images.

Merci d'avance pour votre aide !

Bonne journée,

1 réponse

Messages postés
221
Date d'inscription
jeudi 12 août 2010
Statut
Membre
Dernière intervention
5 juillet 2019
28
Bonjour,
Voilà la macro toute fraiche.
Modifiez là à votre guise.

Public Sub Export_images()
Dim wb As Workbook
Dim sh As Worksheet
Dim path As String
Dim chtObj As ChartObject

Set wb = ThisWorkbook
Set sh = wb.Sheets(1)
path = wb.path & "\Images\"


'/////Sélection des images en colonne 1
For Each shp In sh.Shapes
If Not Intersect(shp.TopLeftCell, sh.Columns(1)) Is Nothing Then
'Export des images
Set chtObj = sh.ChartObjects.Add(300, 300, 400, 250)
chtObj.Name = "TemporaryPictureChart"
chtObj.Width = sh.Shapes(shp.Name).Width
chtObj.Height = sh.Shapes(shp.Name).Height
chtObj.Border.LineStyle = 0
sh.Shapes.Range(Array(shp.Name)).Select
Selection.Copy
sh.ChartObjects("TemporaryPictureChart").Activate
ActiveChart.Paste
ActiveChart.Export Filename:=path & shp.TopLeftCell.Value & ".jpg", FilterName:="jpg"
chtObj.Delete
End If
Next shp
End Sub

Bonne journée
Messages postés
3
Date d'inscription
mercredi 30 mai 2018
Statut
Membre
Dernière intervention
31 mai 2018

Bonjour rEVOLV3r,

Merci pour votre réponse,

Je comprends la facon dont vous vérifiez l'existence des images, et la nature des objets (shapes).

Je pense avoir compris que pour enregistrer l'image vous la copiez en mémoire (où exactement ?), effectuez l'export, pour ensuite la supprimer avant de passer à la suivante. Je ne sais pas si c'est bien ca (ou plus ou moins ahah).

En revanche, vba m'affiche une erreur sur la ligne d'export (photo ci-dessous, sorry mon ordinateur est en espagnol).
j'ai fait des recherches sur la fonction export, la nature des objets (filename + nom en string) me semble respectée, je ne comprends pas l'origine du problème.
Sauriez-vous m'expliquer ?



Merci beaucoup pour votre aide.

Bonne journée,
Messages postés
221
Date d'inscription
jeudi 12 août 2010
Statut
Membre
Dernière intervention
5 juillet 2019
28
Bonjour,

En fait je crée un graphique (chart) dans votre page excel, le redimensionne et lui colle l'image dedans. Puis j'exporte le chart dans le dossier \Images\ qui se trouve à coté du fichier Excel.
Je pense que le soucis vient de là. Mettez votre chemin de dossier (ou vous voulez que les images se sauvegardent) en remplaçant

path = wb.path & "\Images\"

par

path = "c:\local\917672\My Documents\Images\" ou autre

Normalement ça devrait fonctionner.
Bonne journée
Messages postés
3
Date d'inscription
mercredi 30 mai 2018
Statut
Membre
Dernière intervention
31 mai 2018

rEVOLV3r,

En effet, il me fallait enregistrer le fichier Excel dans le fichier même où je veux trouver les photos.

Ca fonctionne super bien !

Merci beaucoup !

Bonne journée
Messages postés
221
Date d'inscription
jeudi 12 août 2010
Statut
Membre
Dernière intervention
5 juillet 2019
28
Bonjour,

Pas de soucis.
Pensez à mettre en résolu ;-)

Bonne journée.