Modifier le propriétés d'une image (mot clé)

Bonjour le forum,

Je réalise un projet qui permet d'identifier les images ne possédant pas de mot clé dans leurs propriétés. Ces images sont référencées dans un tableau.

Une fois que le tableau est complété par ces images dans une autre colonne on écrit le mot clé qu'on aimerait leur attribuer attribuer. J'aimerais enfin que lorsque je clique sur un bouton les propriétés de l'image soient modifiées et que le mot clé choisi soit mit dans les propriétés. Voici le code que j'ai pu trouver :

Dim Img As ImageFile
Dim IP As ImageProcess
Dim v As Vector
Dim i As Integer
Dim DL As Integer

'Création conteneur pour l'image à manipuler
Set Img = CreateObject("WIA.imageFile")

'creation du gestionnaire de filtre
Set IP = CreateObject("WIA.imageProcess")

'création d'un vecteur
'(Un vecteur permet de créer une collection pour des valeurs du même type.)
Set v = CreateObject("WIA.Vector")

DL = Range("Tableau2").Rows.Count

For ligne = 1 To DL

'chargement de l'image
Img.LoadFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

    'définit le filtre pour gérer l'EXIF
    IP.Filters.Add IP.FilterInfos("Exif").FilterID
    IP.Filters(1).Properties("ID") = 40094
        '40091  Titre
        '40092  Commentaire
        '40093  Auteur
        '40094  Mots clés

        'spécifie le type de valeur pour le propriété du filtre:
        'constante VectorOfBytesImagePropertyType = 1101 (la valeur est un vecteur)
        IP.Filters(1).Properties("Type") = VectorOfBytesImagePropertyType
        'voir le fichier d'aide fourni avec la librairie WIA pour
        'obtenir la liste des constantes disponibles

    'stocke une chaine de caractères dans le vecteur
    v.SetFromString Range("Tableau2[MOT CLE SUGGERE]")(ligne).Value

    'applique au filtre le contenu du vecteur
    IP.Filters(1).Properties("Value") = v

    'application du filtre dans l'image
    Set Img = IP.Apply(Img)

    'sauvegarde de l'image
    Img.SaveFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

Next

Ce code permet enfaite de copier l'image et de la recréer avec un mot clé or j'aimerais uniquement modifier les propriétés de l'image originale. J'arrive au bout de ce projet mais je suis totalement bloquée car je ne connais pas d'autres fonctions permettant de le faire... Si vous testez le code vous verrez que il vous renvoie un message d'erreur comme quoi l'image existe déjà ...

Je réfléchis en parallèle à un solution qui serait de supprimer l'image originale avant d'enregistrer la nouvelle mais j'ai peur que ça perde les liens et que je ne puisse plus enregistrer la nouvelle...

Et désolée par avance, non je ne peux pas partager le fichier car il contient des données confidentielles mais je peux fournir le code de la première partie décrite au début du post si ça en intéresse certains.

Bonne journée

Vos idées sont les bienvenues .....

Bonjour Man.403030,

En effet dans ta macro tu charges un fichier image avec un nom bien précis.

Donc tu ne peux pas le sauver sous le même nom dans le même dossier même après avoir modifié ses propriétés.

Je te propose une astuce. En "jouant" sur l'extension.

'applique au filtre le contenu du vecteur
    IP.Filters(1).Properties("Value") = v

    'Ajoute un filtre de conversion pour la nouvelle image (au format JPEG)
        IP.Filters.Add IP.FilterInfos("Convert").FilterID
        IP.Filters(IP.Filters.Count).Properties("FormatID") = wiaFormatJPEG

    'application des filtres en cours dans l'image
    Set Img = IP.Apply(Img)

    'sauvegarde de l'image en Joint Photographic Experts Group
'Donc en modifiant l'extension pour sauver l'image sous extension .jpeg 
    Img.SaveFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value 

'Efface l'image non modifiée
Kill ton chemin d'image.jpg

'Renomme l'image modifiée avec l'extension jpg
Name ton chemin image.jpeg As ton chemin image.jpg
'Next ligne

Le fait de modifier l'extension qui est ici permet de contourner la sauvegarde puisque une image nommée avec extension jpg et la même nommée avec l'extension jpeg sont considérées différentes par le système.

Or le jpeg (qui vient du Mac) et le jpg sont identiques en terme de propriété graphique. C'est uniquement lié qu'avant Microsoft ne gérait ses extensions que sur 3 caractères. Alors que depuis quelques années il a pris le même topo que le système Mac.

Et du coup, comme il existe au moment de l'opération 2 images, en n'en supprimant qu'une tu as moins de souci si pour quelque raison ta modif plante.

Au final tu as une image modifiée retrouvant son extension initiale.

Bonjour,

Je viens de voir votre réponse merci du temps que vous avez pris pour m'aider.

Je suis en train de tester j'ai juste un problème j'ai l'extension .jpg qui est collée dans le tableau avec le nom de l'image donc si je ne change pas ça je vais avoir

"nom de l'image.jpg.jpg" il faut que je remédie à ça

Je vais chercher ça je vous redonne des nouvelles

Après adaptation du code voilà ce que ça donne et ça fonctionne merci beaucoup pour ton aide !!!

Private Sub CommandButton3_Click()

Dim Img As ImageFile
Dim IP As ImageProcess
Dim v As Vector
Dim i As Integer
Dim DL As Integer
Dim x As Integer
Dim NomSansExt As String

'Création conteneur pour l'image à manipuler
Set Img = CreateObject("WIA.imageFile")

'création du gestionnaire de filtre
Set IP = CreateObject("WIA.imageProcess")

'création d'un vecteur
'(Un vecteur permet de créer une collection pour des valeurs du même type.)
Set v = CreateObject("WIA.Vector")

DL = Range("Tableau2").Rows.Count

For ligne = 1 To DL

'x prend la valeur du numéro de caractère à partir duquel se trouve .jpg
x = InStr(1, Range("Tableau2[NOM IMAGE]")(ligne).Value, ".jpg", vbTextCompare)

NomSansExt = Mid(Range("Tableau2[NOM IMAGE]")(ligne).Value, 1, x - 1)

'chargement de l'image
Img.LoadFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

    'définit le filtre pour gérer l'EXIF
    IP.Filters.Add IP.FilterInfos("Exif").FilterID
    IP.Filters(1).Properties("ID") = 40094
        '40091  Titre
        '40092  Commentaire
        '40093  Auteur
        '40094  Mots clés

        'spécifie le type de valeur pour le propriété du filtre:
        'constante VectorOfBytesImagePropertyType = 1101 (la valeur est un vecteur)
        IP.Filters(1).Properties("Type") = VectorOfBytesImagePropertyType
        'voir le fichier d'aide fourni avec la librairie WIA pour
        'obtenir la liste des constantes disponibles

    'stocke une chaine de caractères dans le vecteur
    v.SetFromString Range("Tableau2[MOT CLE SUGGERE]")(ligne).Value

    'applique au filtre le contenu du vecteur
    IP.Filters(1).Properties("Value") = v

    'application du filtre dans l'image
    'Set Img = IP.Apply(Img)

    'Ajoute un filtre de conversion pour la nouvelle image (au format JPEG)
        IP.Filters.Add IP.FilterInfos("Convert").FilterID
        IP.Filters(IP.Filters.Count).Properties("FormatID") = wiaFormatJPEG

    'application des filtres en cours dans l'image
    Set Img = IP.Apply(Img)

    'sauvegarde de l'image en Joint Photographic Experts Group
'Donc en modifiant l'extension pour sauver l'image sous extension .jpeg
    Img.SaveFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

'Efface l'image non modifiée
Kill "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

'Renomme l'image modifiée avec l'extension jpg
Name "S:\Bibliotheques\" & NomSansExt & ".jpeg" As "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

'sauvegarde de l'image
'Img.SaveFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

Next ligne

End Sub

Update : ça ne fonctionne plus quand j'ai plusieurs images à traiter

Je reçois cette erreur sur la ligne

IP.Filters.Add IP.FilterInfos("Exif").FilterID

Il y avait deux images dans le tableau la première a bien fonctionné, il faut probablement faire du ménage avant de relancer sur une autre image mais je ne sais pas quoi rajouter...

Apres des recherches : Il faut rajouter les ligne Set IP = nothing et inclure dans la boucle le début da la procédure avec tous les set

Private Sub CommandButton3_Click()

Dim Img As ImageFile
Dim IP As ImageProcess
Dim v As Vector
Dim i As Integer
Dim DL As Integer
Dim x As Integer
Dim NomSansExt As String

Set IP = Nothing

DL = Range("Tableau2").Rows.Count

For ligne = 1 To DL

'Création conteneur pour l'image à manipuler
Set Img = CreateObject("WIA.imageFile")

'creation du gestionnaire de filtre
Set IP = CreateObject("WIA.imageProcess")

'création d'un vecteur
'(Un vecteur permet de créer une collection pour des valeurs du même type.)
Set v = CreateObject("WIA.Vector")

'x prend la valeur du numéro de caractère à partir duquel se toruve .jpg
x = InStr(1, Range("Tableau2[NOM IMAGE]")(ligne).Value, ".jpg", vbTextCompare)

NomSansExt = Mid(Range("Tableau2[NOM IMAGE]")(ligne).Value, 1, x - 1)

'chargement de l'image
Img.LoadFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

    'définit le filtre pour gérer l'EXIF
    IP.Filters.Add IP.FilterInfos("Exif").FilterID
    IP.Filters(1).Properties("ID") = 40094
        '40091  Titre
        '40092  Commentaire
        '40093  Auteur
        '40094  Mots clés

        'spécifie le type de valeur pour le propriété du filtre:
        'constante VectorOfBytesImagePropertyType = 1101 (la valeur est un vecteur)
        IP.Filters(1).Properties("Type") = VectorOfBytesImagePropertyType
        'voir le fichier d'aide fourni avec la librairie WIA pour
        'obtenir la liste des constantes disponibles

    'stocke une chaine de caractères dans le vecteur
    v.SetFromString Range("Tableau2[MOT CLE SUGGERE]")(ligne).Value

    'applique au filtre le contenu du vecteur
    IP.Filters(1).Properties("Value") = v

    'application du filtre dans l'image
    Set Img = IP.Apply(Img)

    'Ajoute un filtre de conversion pour la nouvelle image (au format JPEG)
        IP.Filters.Add IP.FilterInfos("Convert").FilterID
        IP.Filters(IP.Filters.Count).Properties("FormatID") = wiaFormatJPEG

    'application des filtres en cours dans l'image
    Set Img = IP.Apply(Img)

    'sauvegarde de l'image en Joint Photographic Experts Group
    'Donc en modifiant l'extension pour sauver l'image sous extension .jpeg
    Img.SaveFile "S:\Bibliotheques\" & NomSansExt & ".jpeg"

'Efface l'image non modifiée
Kill "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

'Renomme l'image modifiée avec l'extension jpg
Name "S:\Bibliotheques\" & NomSansExt & ".jpeg" As "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

'sauvegarde de l'image
'Img.SaveFile "S:\Bibliotheques\" & Range("Tableau2[NOM IMAGE]")(ligne).Value

Set IP = Nothing

Next ligne

End Sub

Bonjour Man403030,

Dans le code que je t'ai transmis tu remarqueras qu'il n'existe qu'un seul IP.Apply

En fait quand tu ajoutes des filtres. Ils sont cumulatifs. Ton 1ier porte sur les mots clés

IP.Filters(1).Properties("ID") = 40094

Et le 2ième qui aurait pu être IP.Filters(2).Properties... porte lui sur l'extension.

IP.Filters(IP.Filters.Count).Properties("FormatID") = wiaFormatJPEG