Compression des images dans excel par macro

bonjour
ça fait longtemps que je regarde ce forum pour m'aider dans la création de mes fichiers automatisés(sql via macro excel)
mais là je sèche et je n'arrive pas à trouver une solution pour me dépanner

j'ai plusieurs fichier excel(500/mois) avec de nombreuses images dedans

je souhaiterais réduire la taille de ces fichiers en comprimant les images par macro, mais ça ne fonctionne pas
j'ai essayé les codes

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub CompressionImage() Dim C As CommandBarControl Application.ScreenUpdating = False For Each C In Application.CommandBars("Picture").Controls If TypeOf C Is CommandBarButton Then If C.ID = 6382 Then Application.SendKeys "{DOWN}{TAB}{UP}{ENTER}{ENTER}", True C.Execute Exit For End If End If Next C Application.ScreenUpdating = True End Sub

---

Code:

---

1 2 3 4

Sub CompressPictures() Application.SendKey , "{DOWN}{TAB}{UP}{ENTER}, True" Application.CommandBars("Picture").Controls(10).Execute End Sub

---

je précise que je suis sous excel 2010 et 2013

ce que je ne comprend pas c'est que si j'utilise les macros, elles m'ouvrent une fenêtre(voir image nok) la taille du documents ne change pas et si je compresse les images manuellement, ce n'est pas la même fenètre(voir image ok), là la taille du document change, les photos sont compressées
Pièce jointe 142311Pièce jointe 142312

Salut,

et plutôt que de vouloir passer par tes sendkeys, n'est-il pas plus judicieux (qui a dit simple ?) de passer par ton enregistreur de macro pour voir le code VBA qu'il te propose à la place ?

l'enregistreur de macro ne fonctionne pas pour la compression des images

salut, minimaliste donc à adapter sans doute à ton contexte

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Option Explicit   Private Sub Compression() Dim oCtrl As CommandBarControl With Selection Set oCtrl = Application.CommandBars.FindControl(ID:=6382) Application.SendKeys "%e~" Application.SendKeys "%a~" oCtrl.Execute Set oCtrl = Nothing End With End Sub   Sub TestCompression() Dim Shp As Shape Application.ScreenUpdating = False For Each Shp In ActiveSheet.Shapes If Left$(Shp.Name, 7) = "Picture" Then Shp.Select Compression End If Next Shp Application.ScreenUpdating = True End Sub

---

bonjour
merci de ton aide
mais ça ne fonctionne pas, la compression ne se fait pas, le document n'est pas réduit en taille

re, autant pour moi cela fonctionne sous 2003 mais pas 2007 et +, désolé

Bonjour,

Comme toujours, le VBA ne devrait venir qu'en sus de la connaissance des possibilités d'Excel, comme tu as la chance d'avoir 2010 (2013 se comporte pareil), tu devrais t’intéresser directement aux paramétrages des options en mode Backstage ;)

Vois le snapshot joint (les réglages y sont incrustés), tu as une image sur une feuille qui pèse à la base 1,39 Mo nue, le premier enregistrement est avec le mode sans compression activé, le second avec une sortie cible à 220 pp et le troisième à 96 pp, on passe d'un poids de fichier Excel de 1 434 Ko à 682 puis 86 Ko !

Si plusieurs images, pas besoin de boucler sur chaque image, c'est le classeur qui est concerné !

En ouvrant le classeur à grosse image, en changeant l'option et en sauvant, on a le résultat direct, je te laisse découvrir les différentes imbrications de ceci avec les options de l'onglet contextuel image, voir l'aide d’Excel, c'est bien expliqué ;)

Pièce jointe 142473

Bon reste que pour automatiser tout le process, il faut pouvoir le mettre en VBA, c’est à première vue une propriété de niveau classeur, mais je ne pense pas qu'on y ai accès

Après savoir si on veut peut-être trouver le code du siècle ou juste une solution efficiente qui fera gagner du temps et donc des sous à la boite, chacun son approche, donc on peut utiliser une pirouette pour arriver à nos fins de la manière suivante :

• On crée un classeur modèle .xltm avec 1 seule feuille, vu qu’à chaque utilisation le classeur utilisé sera détruit au profit du nouveau.
• On paramètre son option avancée taille & qualité d’image
• On sauvegarde
• Dans un module de ce modèle, on fait une procédure triviale qui va :
• Ouvrir le classeur cible
• Copier la ou les feuilles voulues dans notre nouveau classeur
• Effacer la feuille de garde de notre classeur de macro
• Sauvegarder le classeur obtenu sous le nom voulu à l’endroit voulu en xlsx ce qui fait qu’on supprime du même coup le code de copie. Notre option de compression a joué son rôle, on a ce qu'on voulait.

Si d’aventure, ce que tu ne précises pas, le classeur d’origine possède lui-même du code, voir les tutos sur le forum pour manipuler du code en VBA via VBProject.VBComponents etc. et rajouter un peu de code donc au modèle.

cordialement,

Didier

bonjour
merci de ta soluce, malheureusement ça fonctionne mais pas complètement

à l'origine le document fait 1.9 mo
si je fais ta procédure, le doc faut 1.2 mo

par contre si je compresse manuellement en passant par la boite de dialogue de excel, le doc fait 0.5mo

Bonsoir,

mets le fichier (ou équivalent sans trucs confidentiels) en PJ et je testerais.

cordialement,

Didier

bonjour
merci de ton aide, voici le fichier, j'ai enlevé tout ce qui était confidentiel

par contre j'ai rajouté,".xls" à la fin, car ce n'était pas compatible avec le forum, il faudrait donc avant de l'ouvrir, supprimer le ".xls", pour laisser ".xlsm"



Pièce jointe 142609

Bonjour,

ton fichier a été sauvegardé en xlsx ainsi : Etude images

le code dans mon modèle (ton fichier a été ouvert manuellement) :

Code:

---

1 2 3 4 5 6 7

Sub DGSoluce() Windows("Etude images.xlsx").Activate Sheets("Feuil1").Select Sheets("Feuil1").Move Before:=Workbooks("DidierBBB1").Sheets(1) ActiveWorkbook.SaveAs "Le cheminVoulu\NouveauPoidsImage.xlsx" ' les feuilles initiales ne sont pas éffacées, c'est du brut... End Sub

---

le résultat : 742 Ko contre 1928 Ko

Pièce jointe 142620

cordialement,

Didier

bonjour
désolé de ne pas avoir répondu tout de suite, mais j'était parti en vacances
juste avant que je parte en vacance j'avais fait les modif, mais à mon retour je m'aperçois que ça ne fonctionne pas correctement

voici ce qui est fait:

-classeur d'origine en xlsx en lecteur seul(toutes les photos ont été compressé en 96p) et ce fichier est paramétré dans les options avancé pour que les images soit en 96p

-avec une macro workbook open, j'ouvre le fichier en lecteur seul

Code:

---

Workbooks.Open filename:="\\" & chemin_gammes & "\" & GAMME_TRI

---

-les utilisateurs rajoutent des photos non compressé!!!!

-avec une macro j'enregistre sous un autre nom et dans un autre répertoire ce fichier avec les photos en plus

Code:

---

ActiveWorkbook.SaveAs filename:=(ThisWorkbook.Path & "\Archivage mode opératoire\" & ThisWorkbook.Worksheets("table3").Range("ig2") & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

---

le pb c'est que les nouvelles photos se sont pas compréssées!!

Bonjour,

10 avril, 10 mai, 1 mois de vacances = bravo ;)

Le souci est que tu n’as pas répondu à la question soulevée dans les posts # 8, 9, 10 & 11 à savoir si la méthode fonctionnait ou non appliquée telle que indiquée dans le contexte du classeur que tu avais envoyé, sur lequel on a pris la peine de bosser et correspondant à la question première.

Là les données changent, et tu reviens, il serait bien de procéder étapes par étapes…

cordialement,

Didier

c'est ça quand on travaille en équipe 5/8, 3 jours de posé->1 semaine de vacances:mouarf:

sinon, je ne peux pas faire exactement ta méthode, c'est pour cela que je l'ai adapté:zoubi:

car le fonctionnement des fichiers est repris dans mon post précédent

une chose étrange que j'ai remarqué aujourd'hui

quand j'ai un fichier avec des images non compressé(le fichier est configuré pour compressé toutes les images en 96p dans les options avancé)
si je fais enregistré sous avec la souris le fichier diminue de taille
si je fais enregistré sous en macro le fichier ne diminue pas de taille!!!

Code:

---

ActiveWorkbook.SaveAs filename:=

---