Discussion :

[monfiston]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Jean-Philippe André]

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 ?

[monfiston]

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

[kiki29]

salut, minimaliste donc à adapter sans doute à ton contexte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[monfiston]

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

[kiki29]

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

[Didier Gonard]

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é



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

[monfiston]

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

[Didier Gonard]

Bonsoir,

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

cordialement,

Didier

[monfiston]

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"



fichier test.xlsm.xls

[Didier Gonard]

Bonjour,

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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



cordialement,

Didier

[monfiston]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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!!

[Didier Gonard]

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

[monfiston]

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

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.SaveAs filename:=