Salut

Petite méthode pour créer ou modifier le commentaire d'une image .jpg
Nom : Image1.jpg Affichages : 902 Taille : 169,9 Ko
Prés requis, Windows XP et suivant.
Le lien qui m'a permis de mettre au point le code Utiliser la librairie Windows Image Acquisition en VBA merci à SilkyRoad
Code VBS : 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
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
Function LireTag(ChemNomImg)
    Dim Img 'As Object ' ImageFile
    'Création conteneur de l'image pour la recherche de l'information "Commentaires"
    Set Img = CreateObject("WIA.imageFile")
    On Error Resume Next
    'Chargement de l'image dans le conteneur
    Img.LoadFile (ChemNomImg)
    If Err Then LireTag = Err.Description: Exit Function
    LireTag = Img.Properties("40092").Value.String
    If Err Then LireTag = Err.Number & vbNewLine & Err.Description: Exit Function
    Set Img = Nothing
End Function
Function EcrireTag(ChemNomImg, NewInfos)
    Dim Img 'As Object ' ImageFile
    Dim ImgProcess' As Object 'ImageProcess
    Dim ImgVector' As Object 'Vector
 
    'Création conteneur de l'image pour la recherche de l'information "Commentaires"
    Set Img = CreateObject("WIA.imageFile")
    On Error Resume Next
    'Chargement de l'image dans le conteneur
    Img.LoadFile (ChemNomImg)
    If Err Then EcrireTag = Err.Description: Exit Function
    EcrireTag = Img.Properties("40092").Value.String 'provoque une erreur si le tag commentaires n'existe pas encore
    If Err.Number <> -2145320857 And Err.Number <> 0 Then EcrireTag = Err.Description: Exit Function
 
    On Error GoTo 0
    ' si Err.Number = -2145320857 création du TAG, si Err.Number = 0 on le modifi
    Set ImgProcess = CreateObject("WIA.imageProcess") 'création du gestionnaire de filtre
    Set ImgVector = CreateObject("WIA.Vector") 'création d'un vecteur
    ImgProcess.Filters.Add ImgProcess.FilterInfos("Exif").FilterID
    ImgProcess.Filters(1).Properties("ID") = 40092
    ImgProcess.Filters(1).Properties("Type") = 1101 'VectorOfBytesImagePropertyType
    ImgVector.SetFromString NewInfos 'stocke une chaine de caractères dans le vecteur
    ImgProcess.Filters(1).Properties("Value") = ImgVector 'applique au filtre le contenu du vecteur
    Set ImgVector = Nothing
    Set Img = ImgProcess.Apply(Img) 'application du filtre dans l'image
    Set ImgProcess = Nothing
	fso.DeleteFile(ChemNomImg)'car Img.SaveFile ne veux pas écraser le fichier
    'sauvegarde de l'image
    Img.SaveFile ChemNomImg
    Set Img = Nothing
    EcrireTag = "OK"
End Function
 
Dim fso,DossierDuProg
Set fso = CreateObject("Scripting.FileSystemObject")
DossierDuProg = fso.GetParentFolderName(wscript.ScriptFullName)
 
msgbox LireTag(DossierDuProg & "\DscEssais.JPG"),64,"Lecture sans le commentaire"
EcrireTag DossierDuProg & "\DscEssais.JPG", "Je pense que cela fonctionne pour la modification du TAG Commentaires"
msgbox LireTag(DossierDuProg & "\DscEssais.JPG"),64,"Lecture après ajout du commentaire"
EcrireTag DossierDuProg & "\DscEssais.JPG", "Voilà pour la démo"
msgbox LireTag(DossierDuProg & "\DscEssais.JPG"),64,"Lecture après modification du commentaire"
Set fso = Nothing
Code HTA : 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
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
        <HEAD>
                <TITLE> Créer ou modifier un commentaire </TITLE>
                <HTA:APPLICATION
                        applicationname="RecupModifComm"
                        version="1"
                        id="RecupModifComm"
                        >
        </HEAD>
        <SCRIPT language="VBScript">
                ' Déclarations utilisables dans toute la partie VBScript
                Dim DossierDuProg, Cpt
        '----------------------------------------------------------------------------------------------------------------------
        Sub Window_Onload()
                Dim ChemNomComplet
                ChemNomComplet = RecupModifComm.CommandLine ' ChemNomComplet = Id du programme.CommandLine
                DossierDuProg = RecupNomChemin(ChemNomComplet)
                DossierDuProg = Replace(DossierDuProg,Chr(34),"")
        End Sub
        '----------------------------------------------------------------------------------------------------------------------
        Function RecupNomChemin(StrSoumis)
                RecupNomChemin = Left(StrSoumis, (InStrRev(StrSoumis, "\", -1, vbTextCompare)))
        End Function
        '------------------------------------------------------------------------------------------------------------------
        Function LireTag(ChemNomImg)
                Dim Img 'As Object ' ImageFile
                'Création conteneur de l'image pour la recherche de l'information "Commentaires"
                Set Img = CreateObject("WIA.imageFile")
                On Error Resume Next
                'Chargement de l'image dans le conteneur
                Img.LoadFile (ChemNomImg)
                If Err Then LireTag = Err.Description: Exit Function
                LireTag = Img.Properties("40092").Value.String
                If Err Then LireTag = Err.Number & vbNewLine & Err.Description: Exit Function
                Set Img = Nothing
        End Function
        '------------------------------------------------------------------------------------------------------------------
        Function EcrireTag(ChemNomImg, NewInfos)
                Dim Img 'As Object ' ImageFile
                Dim ImgProcess' As Object 'ImageProcess
                Dim ImgVector' As Object 'Vector
 
                'Création conteneur de l'image pour la recherche de l'information "Commentaires"
                Set Img = CreateObject("WIA.imageFile")
                On Error Resume Next
                'Chargement de l'image dans le conteneur
                Img.LoadFile (ChemNomImg)
                If Err Then EcrireTag = Err.Description: Exit Function
                EcrireTag = Img.Properties("40092").Value.String 'provoque une erreur si le tag commentaires n'existe pas encore
                If Err.Number <> -2145320857 And Err.Number <> 0 Then EcrireTag = Err.Description: Exit Function
 
                On Error GoTo 0
                ' si Err.Number = -2145320857 création du TAG, si Err.Number = 0 on le modifie
                Set ImgProcess = CreateObject("WIA.imageProcess") 'création du gestionnaire de filtre
                Set ImgVector = CreateObject("WIA.Vector") 'création d'un vecteur
                ImgProcess.Filters.Add ImgProcess.FilterInfos("Exif").FilterID
                ImgProcess.Filters(1).Properties("ID") = 40092
                ImgProcess.Filters(1).Properties("Type") = 1101 'VectorOfBytesImagePropertyType
                ImgVector.SetFromString NewInfos 'stocke une chaine de caractères dans le vecteur
                ImgProcess.Filters(1).Properties("Value") = ImgVector 'applique au filtre le contenu du vecteur
                Set ImgVector = Nothing
                Set Img = ImgProcess.Apply(Img) 'application du filtre dans l'image
                Set ImgProcess = Nothing
                DeleteAFile ChemNomImg 'car Img.SaveFile ne veux pas écraser le fichier
                'sauvegarde de l'image
                Img.SaveFile ChemNomImg
                Set Img = Nothing
                EcrireTag = "OK"
        End Function
        '------------------------------------------------------------------------------------------------------------------
        Sub DeleteAFile(filespec)
                Dim fso
                Set fso = CreateObject("Scripting.FileSystemObject")
                fso.DeleteFile(filespec)
        End Sub
        '------------------------------------------------------------------------------------------------------------------
        Sub LireOnClick()
                Infos.Innertext = LireTag(DossierDuProg & "DscEssais.JPG")
        End Sub
        '------------------------------------------------------------------------------------------------------------------
        Sub EcrireOnClick()
                Cpt = Cpt + 1
                Infos.Innertext = EcrireTag(DossierDuProg & "DscEssais.JPG", Cpt & " Je pense que cela fonctionne pour la modification du TAG Commentaires")
        End Sub
        '------------------------------------------------------------------------------------------------------------------
        </SCRIPT>
        <body>
                        <INPUT Type="button" id="Lire" name="Lire" value="Lire" onClick="LireOnClick" >
                        <INPUT Type="button" id="Ecrire" name="Ecrire" value="Ecrire" onClick="EcrireOnClick" >
                        <BR>
                        <Div Id="Infos"> le commentaire </Div>
        </body>
Il vous faut une image .JPG dans le même dossier ou vous aurez sauvegardé le code ci-dessus, au départ, l'idéal pour la démonstration est d'avoir un fichier qui n'a pas encor de commentaires.
Pensez donc à mettre le nom de votre fichier lignes 50 à 54 pour le VBS et lignes 77 et 82 pour le HTA.

Vous pouvez aller plus loin au vu du tutoriel de SilkyRoad
IP.Filters(1).Properties("ID") = 40091
'40091 Titre
'40092 Commentaire
'40093 Auteur
'40094 Mots clés
de vos commentaires. ------------>