[MJ13]

Bonjour à tous,

J'ai pas mal cherché, mais j'ai rien trouvé

Avec ce code MichelXLD, que je remercie au passage, on peut retravailler des images contenues sur le disque dur et les enregistrer sous un autre format sur le disque dur. Ok
Voici la macro:

'Redimensionner une image 

Sub redimensionnerImage()
Dim Img As Object, IP As Object

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")

Img.LoadFile "C:\Documents and Settings\michel\dossier\fourmiz.JPG"

IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = 90
IP.Filters(1).Properties("MaximumHeight") = 90

Set Img = IP.Apply(Img)
Img.SaveFile "C:\Documents and Settings\michel\dossier\fourmizThumbnail.JPG"
End Sub

Mais peut-on prendre des images mises sur une feuille Excel et les enregistrer sur le Disque dur sur le même principe?

[MichelXld]

bonsoir Michel ... ;o)


j'ai supposé que tu parlais des images ajoutées depuis le menu Insertion (et non issues d'un controle Image)

 
   Const Fichier As String = "C:\ImageTemp.gif"
   
   Dim nb As Byte
   Dim Sh As Shape
   
    'Définit le 1er shape de la feuille comme image
    ' à afficher dans l'UserForm
    Set Sh = Worksheets("Feuil1").Shapes(1)
    
    'copie le shape dans la feuille
    Sh.CopyPicture
    'crée un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, _
                        Sh.Width, Sh.Height).Chart
        .Paste 'colle l'image dans graphique
        ' enregistre le graphique au format gif
        .Export Fichier, "GIF"
    nb = ActiveSheet.ChartObjects.Count
    'supprime le graphique
    ActiveSheet.ChartObjects(nb).Delete

bonne soirée
michel

[Spitnolan08]

Bonsoir MJ13, MichelXLD,

Si j'ai bien compris, après de multiples essais, tu peux partir de ce code En supposant que ton image s'appelle"Picture 1":

Sub testb()
Dim Img As Object
Set Img = ActiveSheet.Shapes("Picture 1")
Img.Copy

Set ch = ActiveSheet.ChartObjects.Add(0, 0, Img.Width, Img.Height)
ch.Border.LineStyle = 0
ch.Chart.Paste

ch.Chart.Export "C:\Documents and Settings\MJ13\Bureau\testMJ13.jpeg", FilterName:="JPEG"
ch.Delete
End Sub

Ce code utilise un objet graphique comme intermédiaire.

Cordialement

Edit : en fait, c'est la même chose que MichelXLD mais écit différemment...et avec 1/4h de retard!
Edit 2 : suivant ta version d'Excel, il faut peut être remplacer Picture par Image

[MJ13]

Bonjour Michel, Spit , le forum.

Merci beaucoup cela marche super , je testerai demain sur une série d'images.

Bonne soirée

PS: Cela devrait bien cloturer mon catalogueur de fichiers.