Le très puissant Exiftool est gratuit. Programme en ligne de commande seulement.

Petit example pour utiliser en écriture a partir de vb. Je n'ai pas le temps de raffiner ça mais voila quand même:


Private Sub cmdÉcrit_Click()
Dim astrMotsClés() As String

Dim dDate As Date
Dim tz As New cTimeZone
Dim inta As Integer
dDate = DateAdd("h", -Val(tz.Offset), Now)
Set tz = Nothing

ReDim astrMotsClés(1 To 2)
astrMotsClés(1) = "Mot clé 1"
astrMotsClés(2) = "Mot clé 2"

ExifInfo "c:\", "C:\test.jpg"
ExifWrite "c:\", "C:\test.jpg", "Ici le titre", "Ici la description", "Ici l'auteur", 5, astrMotsClés, dDate, "Commentaire", "Copyright"
End Sub

Private Function ExifWrite(ExifToolPath As String, Fichier As String, Titre As String, _
                            Description As String, Auteur As String, _
                            Notation As Integer, MotsClés() As String, _
                            dDatePriseDeVue As Date, Commentaires As String, _
                            Copyright As String) As Double
Dim strCommandLine As String
Dim inta As Integer

strCommandLine = ExifToolPath & "exiftool "

If Titre <> "" Then
    strCommandLine = strCommandLine & "-title=""" & Titre & """ "
    strCommandLine = strCommandLine & "-XPTitle=""" & Titre & """ "
End If

If Commentaires <> "" Then
    strCommandLine = strCommandLine & "-UserComment=""" & Commentaires & """ "
    strCommandLine = strCommandLine & "-XPComment=""" & Commentaires & """ "
End If

If Description <> "" Then
    strCommandLine = strCommandLine & "-title=""" & Description & """ "
End If

If Auteur <> "" Then
    strCommandLine = strCommandLine & "-creator=""" & Auteur & """ "
    strCommandLine = strCommandLine & "-XPAuthor=""" & Auteur & """ "
End If

If Copyright <> "" Then
    strCommandLine = strCommandLine & "-xmp:rights=""" & Copyright & """ "
End If

strCommandLine = strCommandLine & "-DateTimeOriginal=""" & dDatePriseDeVue & """ "

Dim intNotationPourcent As Integer
Select Case Notation
    Case Is = 0
        intNotationPourcent = 0
    Case Is = 1
        intNotationPourcent = 1
    Case Is = 2
        intNotationPourcent = 25
    Case Is = 3
        intNotationPourcent = 50
    Case Is = 4
        intNotationPourcent = 75
    Case Is = 5
        intNotationPourcent = 99
    Case Else
        intNotationPourcent = 0
End Select

If Notation < 6 Then
    strCommandLine = strCommandLine & "-Rating=""" & Notation & """ "
    strCommandLine = strCommandLine & "-RatingPercent=""" & intNotationPourcent & """ "
Else
    strCommandLine = strCommandLine & "-Rating=5 "
    strCommandLine = strCommandLine & "-RatingPercent=""" & 99 & """ "
End If

For inta = LBound(MotsClés) To UBound(MotsClés)
    strCommandLine = strCommandLine & "-keywords=""" & MotsClés(inta) & """ "
    strCommandLine = strCommandLine & "-LastKeywordXMP=""" & MotsClés(inta) & """ "
    strCommandLine = strCommandLine & "-Subject=""" & MotsClés(inta) & """ "
Next inta

strCommandLine = strCommandLine & "-XPKeywords=""" & Join(MotsClés, ";") & """ "

strCommandLine = strCommandLine & "-k -fast " 'k pour que la fenetre ne se ferme pas, fast surement inutile en ecriture

strCommandLine = strCommandLine & """" & Fichier & """"

ExifWrite = Shell(strCommandLine, vbNormalFocus) 'Pour que la fenetre ne se ferme pas

End Function

Private Sub ExifInfo(ExifToolPath As String, Fichier As String)
Dim strCommandLine As String
Dim inta As Integer

strCommandLine = ExifToolPath & "exiftool "
strCommandLine = strCommandLine & "ScanForXMP "
strCommandLine = strCommandLine & """" & Fichier & """ -k"

Shell strCommandLine, vbNormalFocus

End Sub

Hugo