Poids d'une image dimensionnée par macro

Version imprimable

22/02/2022, 09h01
retraite83

Poids d'une image dimensionnée par macro
Bonjour,

Je dimensionne par macro une image insérée manuellement par l'utilisateur :
Code:

1 2 3 4 5 With H.Pictures(sh.Name) .ShapeRange.LockAspectRatio = msoFalse .Height = 300 .Width = 439 End With
cela marche très bien, cependant j'ai une surprise au niveau de la taille de mon fichier après redimensionnement, je m'explique

Mon fichier fait x Ko

1) Si je dimensionne une photo par exemple de 300 Ko avec photofiltre en 439 X 300 elle devient 100 Ko

J'insère manuellement la photo et j'exécute ma macro avec le dimensionnement : mon fichier = x + 100 Ko

Normal

2) Si j'insère directement la photo de 300 Ko et que j'exécute ma macro avec le dimensionnement :

La photo prend bien la taille voulue mais mon fichier = x + 300 Ko

La photo est réduite mais le poids de la photo d'origine est conservée.

Peut-on remédier à cela ?
22/02/2022, 14h17
78chris

Bonjour

Quant tu sélectionnes une image tu as dans l'onglet Format d'image le bouton Compresser les images des options de taille et d'application à une ou toutes les images.

Avec l'enregistreur macro tu trouveras comment coder les paramètres qui te conviennent
22/02/2022, 19h29
retraite83
Bonjour Chris

Merci pour la piste que tu me donnes, j'ai donc lancé l'enregistreur de macro

Puis j'ai fait :

Sélectionner une image / format d'image / compresser / OK

J'arrête l'enregistreur, surprise voilà le résultat
Code:

1 2 3 4 5 6 7 Sub a() ' ' a Macro ' ActiveSheet.Shapes.Range(Array("Picture 9")).Select End Sub
J'ai refait plusieurs fois, idem à chaque fois...
22/02/2022, 20h11
78chris

Arf

Fils sur le sujet https://www.developpez.net/forums/d1...s-excel-macro/
https://www.developpez.net/forums/d1...rtion-fichier/

Ici aussi https://stackoverflow.com/questions/...rkbook-via-vba

En espérant que cela résolve...
23/02/2022, 15h42
retraite83

Bonjour,

j'ai tenté toutes les possibilités, dans tous les cas l'image est bien réduite mais le poids reste toujours le poids de l'image d'origine (malgré le message actant la compression de l'image)

Je ne comprends pas pourquoi dans mon test une image de 1136 X 1300 réduite en 439 X 300 à toujours le même poids que l 'image avant réduction

Pour moi moins de pixel = moins de poids

C'est d'ailleurs ce qui se passe quand je fais la réduction avec photofiltre...
23/02/2022, 17h01
laurent_ott

Bonjour.
J'ai retrouvé un code qui modifie la taille d'une image au format BMP.
Il faudrait donc en source un fichier BMP, connaitre les nouvelles dimensions désirées pour sauvegarder la nouvelle image avec ces dimensions.
Puis vous chargez dans votre application l'image réduite.
Est-ce que ce format BMP conviendrait ?

Cordialement.
23/02/2022, 17h46
retraite83

Bonjour et merci

le format des images est JPG, il s'agit d'un catalogue existant que l'utilisateur peut mettre à jour directement maintenant

je cherche à réduire le poids des images pour que ce catalogue ne grossisse pas démesurément.

La solution alternative est d'imposer une réduction avec Photofiltre avant l'insertion mais cela n'est pas optimum de demander cela à un utilisateur
23/02/2022, 17h58
laurent_ott

Alors il ne reste plus qu'à trouver une fonction qui transforme les JPG en BMP et l'inverse.
23/02/2022, 18h42
retraite83

Je doute que cela existe...

Je trouve très curieux quand même qu'une réduction de l'image en hauteur et largeur n'implique pas une réduction du poids de cette image, il y a là quelque chose d'anormal que je ne saisis pas.
23/02/2022, 19h21
retraite83
Bonsoir,

j'ai trouvé une solution qui résout mon problème,

une fois l'image copiée il suffit de sélectionner la cellule sur laquelle est l'image et d'ajouter les 2 lignes suivantes :
Code:

1 2 Application.SendKeys "%jym{TAB}{TAB}{UP}~" Application.CommandBars.ExecuteMso "PicturesCompress"
Ne me demandez pas pourquoi, je n'en ai aucune idée mais cela fonctionne bien.

Je vais cependant tester dans tous les sens
23/02/2022, 19h21
laurent_ott

Bonjour.
J'ai trouvé sur internet comment convertir un JPG en BMP, je regarderai demain comment faire l'inverse.
Pour répondre à ta question : ne pas confondre résolution d'affichage et taille de l'image.
Cordialement.
23/02/2022, 19h25
retraite83
Bonsoir,

je pense avoir trouver une solution qui fonctionne (#10)

Mon image est même plus petite qu'avec photofiltre et la qualité visuelle identique

je vais quand même valider...

Si un expert sais déchiffrer les 2 lignes que j'ai ajouté cela m'intéresse de comprendre
Code:

1 2 Application.SendKeys "%jym{TAB}{TAB}{UP}~" Application.CommandBars.ExecuteMso "PicturesCompress"
La 2eme ligne on peut deviner mais la première ??
24/02/2022, 06h54
jurassic pork

1 pièce(s) jointe(s)
Hello,
Citation:
Envoyé par retraite83

Si un expert sais déchiffrer les 2 lignes que j'ai ajouté cela m'intéresse de comprendre

Code:

1 2 Application.SendKeys "%jym{TAB}{TAB}{UP}~" Application.CommandBars.ExecuteMso "PicturesCompress"

La 2eme ligne on peut deviner mais la première ??
Je ne suis pas un expert mais voici peut-être l'explication :
En fait la première ligne de code correspond à ce qui va être envoyé dans la fenêtre de commande de la deuxième ligne (Compression d'images).

Pour Excel 2016 la fenêtre de compression d'images ressemble à cela :

Pièce jointe 614292

En particulier sur ta première ligne de commande il y a le choix des options et un ~ à la fin pour simuler une touche entrée.
Tu as de la chance que la première ligne fonctionne car cela ne correspond plus aux options pour les versions d'Excel récentes. Seuls le {TAB}{TAB}{UP} est effectif et en fait sélectionne l'option Courrier celle qui compresse le plus.
Pour sélectionner les options directement il faut faire un ALT+{Lettre de l'option} en sendKeys %+{Lettre de l'option}
Exemple pour sélectionner l'option Courrier (96ppp) dans la fenêtre de compression d'images et lancer la compression de l'image sélectionnée :
Code:

1 2 Application.SendKeys "%C~" Application.CommandBars.ExecuteMso "PicturesCompress"
Ami calmant, J.P
24/02/2022, 11h35
laurent_ott

Bonjour.
J'ai trouvé la solution sur develeppez.net : il suffit de lire la documentation de silkyroad : https://silkyroad.developpez.com/VBA...geAcquisition/

Chapitre II-A-3. Redimensionner une image

En liaison tardive il faut remplacer : Dim Img As WIA.ImageFile, IP As WIA.ImageProcess

par : Dim Img As Object, IP As Object

Cordialement.

Avec la même source on peut facilement développer une fonction pour convertir un fichier image en BMP, GIF, JPG, PNG, ou TIF :

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
'---------------------------------------------------------------------------------------
Public Function ConvertirImage(ImageSource As String, ImageDestination As String, _
                               Optional Qualité As Integer = 100) As Boolean
'---------------------------------------------------------------------------------------
' Convertit une image source en BMP, GIF, JPG, PNG, TIF
' L'extension de l'image destination indique le format à appliquer.
'---------------------------------------------------------------------------------------
' Exemple pour convertir une image BMP en JPG:
' Call ConvertirImage("C:\_Temporaire\foret.bmp", "C:\_Temporaire\foret.jpg")
'---------------------------------------------------------------------------------------
' Sources: https://silkyroad.developpez.com/VBA/WindowsImageAcquisition/
'          https://www.devhut.net/vba-wia-convert-the-image-format/
'---------------------------------------------------------------------------------------
Dim Img As Object, IP As Object
Dim FormatID As String
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Le format à appliquer est déduit de l'extension du fichier image destination:
Select Case UCase(Right(ImageDestination, 4))
    Case ".BMP": FormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
    Case ".JPG": FormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    Case ".GIF": FormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
    Case ".PNG": FormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
    Case ".TIF": FormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
    Case Else
        Err.Raise vbObjectError, , "L'extension du fichier image destination [" & ImageDestination & "] n'est pas reconnue."
End Select
 
' Création conteneur pour l'image à manipuler:
Set Img = CreateObject("WIA.ImageFile")
' Création du gestionnaire de filtre:
Set IP = CreateObject("WIA.ImageProcess")
' Chargement de l'image dans le conteneur:
Img.LoadFile ImageSource
' Ajoute le filtre pour convertir l'image (Convert):
IP.Filters.Add IP.FilterInfos("Convert").FilterID
' Définit le format:
IP.Filters(1).Properties("FormatID") = FormatID
' Définit la qualité:
If Qualité < 1 Or Qualité > 100 Then Qualité = 100
IP.Filters(1).Properties("Quality") = Qualité
' Application du filtre à l'image:
Set Img = IP.Apply(Img)
' Enregistre l'image:
If Dir(ImageDestination) <> "" Then Kill ImageDestination
Img.SaveFile ImageDestination
ConvertirImage = True
 
' Gestion des erreurs:
Gest_Err:
If Err.Number <> 0 Then MsgBox "Erreur: " & Err.Number & " - " & Err.Description, _
                        vbCritical + vbOKOnly, "ConvertirImage"
Err.Clear
End Function
'---------------------------------------------------------------------------------------

Cordialement.