Enregistrer une image depuis excel dans un fichier
Résolu/Fermé
WhatsupVba
Messages postés
3
Date d'inscription
mercredi 30 mai 2018
Statut
Membre
Dernière intervention
31 mai 2018
-
30 mai 2018 à 23:42
rEVOLV3r Messages postés 223 Date d'inscription jeudi 12 août 2010 Statut Membre Dernière intervention 21 septembre 2022 - 1 juin 2018 à 08:03
rEVOLV3r Messages postés 223 Date d'inscription jeudi 12 août 2010 Statut Membre Dernière intervention 21 septembre 2022 - 1 juin 2018 à 08:03
A voir également:
- Enregistrer une image depuis excel dans un fichier
- Fichier rar - Guide
- Liste déroulante excel - Guide
- Fichier host - Guide
- Fichier iso - Guide
- Audacity enregistrer son pc - Guide
1 réponse
rEVOLV3r
Messages postés
223
Date d'inscription
jeudi 12 août 2010
Statut
Membre
Dernière intervention
21 septembre 2022
28
31 mai 2018 à 08:15
31 mai 2018 à 08:15
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
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
31 mai 2018 à 16:34
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,
31 mai 2018 à 16:48
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
31 mai 2018 à 17:08
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
1 juin 2018 à 08:03
Pas de soucis.
Pensez à mettre en résolu ;-)
Bonne journée.