Autres Modifier Meta Data de fichiers images JPG en lot avec VBA Excel MS Office Pro 2021

[wolfhervé]

Bonjour à tous,

Pas grand adepte du code VBA, si vous pouviez m’apporter un peu d’aide pour comprendre pourquoi le méta data modifiés sur mes fichiers images apparaissent bien dans les propriétés du fichier sous Windows et absolument pas dans les propriétés de l’image sous Photoshop. Il ne m’est donc absolument pas possible de récupérer ces informations sur mon site web.

Si joint le fichier avec la présentation et le code de mon programme.

D'avance merci de votre aide
Hervé

 

[Zon]

Salut

Sous Photoshop , tu as regardé sous l'onglet IPTC ou données de la caméra ???

C'est pas une question de norme Exif ou XMP ??? pas du tout ma spécialité...

Sinon quasi impossible de traiter ta demande, tu utilises des fonctions persos comme enumfichiers, des objets persos comme Vector (qui vient de Visual Basic mais en VBA il faut le créer..) . sans mettre le code ..

Il faut faire l'effort de mettre un fichier Excel, lire la charte du forum.


A+++

 

[wolfhervé]

Bonjour

ci joint le fichier Excel décrit précédemment

Sous Photoshop il y a bien les informations concernant les paramètres de prise de vue.

J'ai constaté dans mes recherches que cela parle d'Exif, Xmp mais je n'ai rien trouvé de très clair sur le sujet, découvrant tout cela.

Comment faire pour remplir avec vba les informations Xmp ?

d'avance merci,

 

[Zon]

Salut

Apres recherche et test, on travaille sur Exif en VBA alors qu'il faudrait travailler en XMP.

Il existe un SDK sur Adobe avec les Tags XMP , c'est le bazar....Je suis trop vieux pour me lancer la dedans , peut être que sur les forums anglophones...

Sinon , une piste sur Photoshop tu peux exporter Un modele Photoshop avec tout ce que tu veux y mettre.
Cela reste un fichier texte avec une extension XMP. AVec VBA on peut écrire dans des fichers textes, et ensuite depuis Photoshop reimporter pour une image. Essaies de faire le test à la main.

 

[kiki29]

Salut, à titre de curiosité :
Comment obtenir les informations étendues d'un fichier ?
Utiliser la librairie Windows Image Acquisition en VBA

 

[Zon]

Salut, à titre de curiosité :
Comment obtenir les informations étendues d'un fichier ?
Utiliser la librairie Windows Image Acquisition en VBA

Merci Kiki29

j'ai adapté le vbscript j'obtiens 321 propriétés, la photo j'avais rajouté des tags sur Photoshop , je ne les retrouve pas sur ce listing . Photoshop (XMP) ne parle pas le même langage que Windows (exif)

 

[TooFatBoy]

Bonjour,

Si les métadonnées Exifs vous permettent d’avoir accès aux paramètres de prises de vue de vos images, les données XMP ont elles, une tout autre finalité : enregistrer les opérations de retouche effectuées sur vos photos…

Le reste de l'article, si besoin :

Qu'est ce que les métadonnées XMP ? a quoi ça sert ?

Si vous avez choisi le format Raw et que vous utilisez un logiciel de retouche non destructif, vous devez savoir à quoi correspondent les métadonnées XMP.

www.photograpix.fr

 

[wolfhervé]

Bonjour

Je fais suite à ma propre question sur la modification des Métas d'une photo.
Après compréhension des différents tags Exif, Xmp, IPTC j'ai modifié mon code pour permettre leurs mises à jours en lot via une macro.

le code donne ceci : ( si besoin modifier les lignes référencés par des cellules, en valeur)

Public Sub CmdShell_Ecrit()

Dim inta As Integer
Dim CheminProg As String
Dim CheminPhoto As String

Dim Titre As String
Dim Description As String
Dim Auteur As String
Dim astrMotsClés As String
Dim Ville As String
Dim Pays As String
Dim Copyright As String
Dim UrlCopy As String
Dim Catagorie As String
Dim ComplCat As String

Dim Ligne As Integer

CheminProg = Cells(5, 2).Value

' Select cell A10 départ de la liste
  Range("A10").Select
  Ligne = 10
  'parcours tant que pas vide
  Do While (Cells(Ligne, 1).Value <> "")
    ' valeurs qui changent en fonction de l'image sélectionnée
    CheminPhoto = Cells(4, 2).Value + Cells(Ligne, 1).Value
    Titre = Cells(Ligne, 2).Value
    Description = Cells(Ligne, 2).Value
    Ville = Cells(Ligne, 3).Value
    Pays = Cells(Ligne, 4).Value
   
    ' paramètre fixe
    Auteur = "xxxxxxxxxxxxx"
    astrMotsClés = "Photographie"
    Copyright = "Copyright HB - 2023"
    UrlCopy = "[URL]https://photolibart.hd.free.fr[/URL]"
    Catagorie = "PHO"
    ComplCat = "Photographie"
   
    ExifWrite CheminProg, CheminPhoto, Titre, Description, Auteur, 12, astrMotsClés, Ville, Pays, Copyright, UrlCopy, Catagorie, ComplCat
   
    ' Descendez d'une rangée à partir de l'emplacement actuel.
    Ligne = Ligne + 1
  Loop
MsgBox "Traitement terminé"
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, _
                            Ville As String, Pays As String, _
                            Copyright As String, UrlCopy As String, _
                            Categorie As String, ComplCat As String) As Double

Dim strCommandLine As String
Dim inta As Integer

'Tags récupéré via commande shell
'SourceFile , IPTC: ObjectName , IPTC: Headline ,
'IPTC: Category , IPTC: SupplementalCategories ,
'IPTC: Caption -Abstract, xmp: Description , EXIF: ImageDescription ,
'IPTC: Keywords ,
'IPTC: City , IPTC: Country -PrimaryLocationName,
'xmp: Rights , IPTC: CopyrightNotice , EXIF: Copyright ,
'IPTC: By -Line, IPTC: Writer -Editor, xmp: Creator , EXIF: Artist ,
'xmp: CreatorWorkURL

' créer la ligne de commande shell avec les informations à integrer
strCommandLine = ExifToolPath & "exiftool " ' répertoire execution exiftool.exe

strCommandLine = strCommandLine & "-IPTC:ObjectName=""" & Titre & """ "
strCommandLine = strCommandLine & "-iptc:Headline=""" & Titre & """ "
strCommandLine = strCommandLine & "-title=""" & Titre & """ "
strCommandLine = strCommandLine & "-XPTitle=""" & Titre & """ "

strCommandLine = strCommandLine & "-iptc:Caption-Abstract=""" & Description & """ "
strCommandLine = strCommandLine & "-xmp:Description=""" & Description & """ "
strCommandLine = strCommandLine & "-EXIF:ImageDescription=""" & Description & """ "

strCommandLine = strCommandLine & "-iptc:by-line=""" & Auteur & """ "
strCommandLine = strCommandLine & "-IPTC:Writer-Editor=""" & Auteur & """ "
strCommandLine = strCommandLine & "-xmp:Creator=""" & Auteur & """ "
strCommandLine = strCommandLine & "-EXIF:Artist=""" & Auteur & """ "
strCommandLine = strCommandLine & "-creator=""" & Auteur & """ "
strCommandLine = strCommandLine & "-XPAuthor=""" & Auteur & """ "

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 = 99
End Select

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

strCommandLine = strCommandLine & "-iptc:Keywords=""" & MotsClés & """ "

strCommandLine = strCommandLine & "-iptc:city=""" & Ville & """ "
strCommandLine = strCommandLine & "-iptc:Country-PrimaryLocationName=""" & Pays & """ "

strCommandLine = strCommandLine & "-iptc:copyrightnotice=""" & Copyright & """ "
strCommandLine = strCommandLine & "-xmp:Rights=""" & Copyright & """ "
strCommandLine = strCommandLine & "-EXIF:Copyright=""" & Copyright & """ "

strCommandLine = strCommandLine & "-xmp:CreatorWorkURL=""" & UrlCopy & """ "
strCommandLine = strCommandLine & "-UserComment=""" & UrlCopy & """ "
strCommandLine = strCommandLine & "-XPComment=""" & UrlCopy & """ "

strCommandLine = strCommandLine & "-iptc:Category=""" & Categorie & """ "
strCommandLine = strCommandLine & "-iptc:SupplementalCategories=""" & ComplCat & """ "
strCommandLine = strCommandLine & " -overwrite_original " ' évite la création d'un double du fichier en extension _original
'strCommandLine = strCommandLine & "-k " '-fast " 'k pour que la fenetre ne se ferme pas, fast surement inutile en ecriture
strCommandLine = strCommandLine & " -L " '-L pour ne pas transformer le langage latin en utf8 fichier est codé en Latin1 sauf si le CodedCharacterSet enregistré est « ESC % G » (UTF8),
strCommandLine = strCommandLine & "-IPTC:CodedCharacterSet=utf8 " ' permet les accent sur les lettres Français
strCommandLine = strCommandLine & """" & Fichier & """"
'Debug.Print strCommandLine

ExifWrite = Shell(strCommandLine, vbNormalFocus)
End Function

Je clos le sujet ayant trouvé la solution à mon besoin.

 

[TooFatBoy]

Pour que le code soit un peu plus lisible, il est préférable d'utiliser la balise code=vb. 😉