XL 2016 Lister fichiers avec Exifs et propriétés (suivant son choix) - code à modifier

[re4]

Edit 19/04/2021 : Les solutions sont aux posts #28 et #44 un grand merci à Dudu2

Bonjour à tous,
Je reviens avec une autre idée avec le code ci-dessous que j'ai légèrement modifé avec quelques annotations de débutant (que je suis ,-)
Cette macro fonctionne bien et extrait seulement les exifs que l'on désire avec quelque prérequis.

Je ne sais pas faire, vous est-il possible de m'aider et de la modifié pour :
1- Aller chercher le répertoire par l'ouverture d'une boite (explorer ?), à la place de : Set objFolder = objShell.Namespace("C:\Users\PC\Pictures\Test")
2- Lister à partir du dossier racine tous les fichiers de tous les sous répertoires.

Merci beaucoup

'original ?
    'https://www.excel-downloads.com/threads/macro-pour-extraire-l

    'Prérequis
    'créer une feuille ''Code'' avec en tête en ligne 1:
    'Colonne A les codes de toutes propriétés
    'Colonne B les noms de ces propriétés
    'Colonne C un X par exemple pour ne choisir que les plus utiles
    'Colonne D index par ordre de péférence (noms que l'on veut, puis tris de A-Z sur colonne D)
    'Colonne E les codes (colonne A) du tri de D

    ' Ne liste que le repertoire choisi (mais affiche les dossiers sous répertoire en nom)

    Sub LireExifTags5()
    Dim det_Headers(355)

    Sheets("Code").Select

    ' compte le nbre de cellule non vide de la colonne E de la feuille 'Code'
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("C:\Users\PC\Pictures\Test")

    Workbooks(1).Sheets(1).Activate
        DernLigClear = Range("A" & Rows.Count).End(xlUp).Row

        Range("A2:OJ" & DernLigClear).ClearContents 'jusqu'a la colonne 400

    For i = 2 To LastRow
    c = i - 2
    k = Worksheets("Code").Cells(i, 5) 'Seulement les exifs que l'on désire

    det_Headers(c) = objFolder.GetDetailsOf(objFolder.Items, k)
    ActiveSheet.Cells(2, c + 1) = det_Headers(c) 'headers en ligne 2

    Workbooks(1).Sheets(1).Activate
    j = 3 ' pour datas en ligne 3

    For Each strFileName In objFolder.Items
    For m = 1 To LastRow
    Next

    Sheets(1).Cells(j, i - 1).Value = objFolder.GetDetailsOf(strFileName, k)

    j = j + 1

    Next
    Next

    'Columns("A:z").AutoFit
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    End Sub

 

[Dudu2]

Bonjour,
1-

Function SélectionRépertoire() As String
    Dim Fdl As FileDialog

    Set Fdl = Application.FileDialog(msoFileDialogFolderPicker)
    Fdl.Show
    If Fdl.SelectedItems.Count = 0 Then Exit Function
  
    SélectionRépertoire = Fdl.SelectedItems(1)
End Function

2- Voir ce classeur qui fait une liste des fichiers d'un répertoire et des sous-répertoires et exploiter la liste des fichiers selon besoins.

 

[re4]

Bonjour
Merci pour ta réactivité.
Comme indiqué , je suis débutant et pas très calé avec VBA... :-(
J'ai testé le code de la pièce jointe il y a une erreur ''Sub ou Fonction non definie'' sur = TransposeExcel

pour le code ''SélectionRepertoire()'' j'avais vu ce code mais je ne sais pas l'insérer à la place de : Set objFolder = objShell.Namespace("C:\Users\PC\Pictures\Test")

Bon We

 

[Dudu2]

Je vais faire un code qui utilise ces fonctions en incluant les images et les hyperliens sur les images.
Il y a combien de tags ? 355 ? 400 ?
Quels sont les numéros des tags qu'on veut pour les images ?
Quels sont les extensions images ? .jpg, .jpeg, .gif, .tiff, .bmp, .png ? Autres ?

 

[re4]

Dudu2, merci pour ton implication mais je n'ai pas besoin de tout ça (si j'ai bien compris), je m'explique :
1-Si tu parles d'inclure les images dans la feuille, pas de besoin pour ce code et en plus ça va alourdir le fichier et l'extraction sera très longue (j'ai déjà une macro qui fait ça au minima).
2- lien hypertexte pourquoi pas mais pas indispensable
3- Dans l'extraction que j'ai faite il y a 328 tags
4- Attention, il ne faut pas tenir compte de tous les tags mais seulement de ceux que l'on a choisi dans la feuille ''Code'' (voir les prérequis dans le code de mon premier post). Pour être plus clair seulement les codes de la colonne E qui seront choisi par l’utilisateur (par exemple seulement : Nom, Auteur, Dimension, Chemin du fichier), c'est pour ça qu'il vaut mieux passer par la feuille code c'est plus souple.
5- Le code d’origine faisait l'extraction de tous les tags, pas utile et très long, c'est pour ça que je l'ai humblement modifier.
6- pour les extensions partons sur toutes *.* mais, généralement, dans les répertoires et sous répertoires il y aura principalement jpg, raw, cr2, dng, tiff, png

Le besoin actuel est seulement de modifier le code posté pour aller chercher un répertoire racine en ouvrant une fenêtre et de lister tous les fichiers du répertoire racine et de tous les fichiers de tous les sous répertoires

Ce que tu proposes peut-être certainement très utiles mais j'en ai pas besoin pour l'instant.

Encore merci

 

[Dudu2]

Ok, je n'ai vu ta réponse que tardivement.
J'ai fait un code en pensant à mon usage personnel aussi car cette liste m'intéresse, et donc j'ai la totale.
Tu peux éventuellement y piocher ce qui t'intéresse.
Je ne crois pas que prendre tous les fichiers soit une bonne idée, en tous cas quand je l'ai fait un fichier "Thumbs.db" a planté le code parti en boucle.
Il est vrai que le temps d'exécution est un peu long car il faut compter 1/3 de seconde par image sur mon PC (les fichiers sont sur HDD, pas sur SSD).
Mais bon, en ce qui me concerne, c'est pas le truc que je fais tous les jours.
Concernant les Tags, j'ai tout listé et pris ceux qui donnaient une information sur mes photos, et il y en a pas mal.
Quelques paramètres à ajuster si nécessaire:

'---------------------
'Constantes paramètres
'---------------------
Private Const TagsPhoto = "1,2,3,4,5,6,9,10,11,12,19,30,31,32,35,53,160,161,162,163,164,173,182," & _
                          "230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251"

Private Const AfficherMiniature = True
Private Const LargeurMiniature = 7
Private Const HauteurMiniature = 30
Private Const ExtensionsPhotos = "jpg,jpeg,jpe,gif,tiff,png,bmp,raw,cr2,dng"

 

[Dudu2]

Le besoin actuel est seulement de modifier le code posté pour aller chercher un répertoire racine en ouvrant une fenêtre et de lister tous les fichiers du répertoire racine et de tous les fichiers de tous les sous répertoires

Si ton besoin est limité à cet aspect, le post #2 donne la réponse.
Si tu ne sais pas l'intégrer je vais tenter de le faire sur la base de ton code du post #1 si c'est ça que tu veux.

 

[Dudu2]

Bon en fait dans ton code, c'est compliqué à intégrer le parcours des sous-répertoires.
Tu peux éventuellement reprendre mon fichier en post #6 que je viens de modifier et si tu ne veux pas des miniatures, valoriser la constante:

Private Const AfficherMiniature = False

 

[re4]

Merci encore, je vois que tu es un passionné de photos aussi, quant à moi, ma connaissance du VBA est très limité.
Pour mon utilisation je préfère lister le besoin dans une feuille et pas aller modifier une macro, ça aussi l'avantage de partager le fichier plus facilement (c'est mon avis), en plus j'ai constaté dans le passé que suivant la version de windows et ou 32 / 64bit s les codes pouvaient varier, je ne sais pas si c'est toujours le cas.
Ne te prends pas trop la tête sauf si c'est ton besoin.
Je veux bien que tu intègres dans le code d'aller ouvrir un répertoire j'ai essayé mais sans succès.
Je testerai ton fichier demain
Bonne soirée

PS : peut être que la prochaine étape serait de lister les photos d'un catalogue Lightroom, je n'ai pas encore cherché s'il existe quelque chose là dessus.

 

[re4]

Bonjour Dudu2
Ton fichier du post 6 est top de top, bravo ! je l'utiliserai
Je vais essayer de l'adapter pour n'afficher que les tags dont j'ai besoin via une feuille ''Code'' (encore elle ,-)
L'deal pour moi est d'aller scanner la colonne E comme le code du post 1,
encore une fois c'est ma vision et peut-être pas celle que l'on devrait appliquer (...)
Je ne voudrai pas aller modifier la macro pour chaque besoin.

Encore mille mercis
Bonne journée

 

[Dudu2]

Je vais essayer de l'adapter pour n'afficher que les tags dont j'ai besoin via une feuille ''Code'' (encore elle ,-)

La liste des codes est dans la constante:

Private Const TagsPhoto = "1,2,3,4,5,6,9,10,11,12,19,30,31,32,35,53,160,161,162,163,164,173,182," & _
                          "230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251"

Pas la peine d'aller mettre ça dans une feuille. Il suffit d'adapter cette liste.

Edit: j'ai modifié le fichier du post #6 pour quelques détails dont l'augmentation de la taille des miniatures en paramétrage. Et activer le bouton "Interrompre" qui restera visible avec la barre de progression en cas de swap aller/retour vers une autre application, quand Excel n'affiche plus rien car occupé à faire son job sous Application.ScreenUpdating = False.

 

[re4]

La liste des codes est dans la constante:

Private Const TagsPhoto = "1,2,3,4,5,6,9,10,11,12,19,30,31,32,35,53,160,161,162,163,164,173,182," & _
                          "230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251"

Pas la peine d'aller mettre ça dans une feuille. Il suffit d'adapter cette liste.

Edit: j'ai modifié le fichier du post #6 pour quelques détails dont l'augmentation de la taille des miniatures en paramétrage. Et activer le bouton "Interrompre" qui restera visible avec la barre de progression en cas de swap aller/retour vers une autre application, quand Excel n'affiche plus rien car occupé à faire son job sous Application.ScreenUpdating = False.

 

[re4]

Oui mais l'idée était de l'utiliser sans rentrer dans la programmation pour que les membres de notre club photo puissent l'utiliser (comme moi, ils sont plus doués en photo qu'en VBA,
Bien vu pour le paramétrage des miniatures

 

[Dudu2]

Si c'est ce que tu veux faire...
Une autre solution consiste à masquer les colonnes dont tu ne voudrais pas à la fin du programme.
Ou si tu veux pouvoir les masquer au début du programme, je peux modifier pour que les AutoFit des colonnes ne s'appliquent qu'aux colonnes non masquées.

 

[re4]

Merci Dudu2, ce n'est que mon avis bien sur, mais il me semble que plus il y a de colonnes plus le temps de traitement sera long, et dans mon besoin je n'aurai besoin que de quelques tags et qui risquent de n'être pas toujours les mêmes et surtout il faudrait éviter d'aller modifier la macro à chaque fois que l'on veut modifier un tag.
Peux tu me donner la marche à suivre stp pour remplacer les n° de tags de Private Const TagsPhoto par des données venant d'une feuille, c'est une vision simplifiée car je ne sais pas si c'est les bons termes.
Dans tous les cas c'est un super boulot et encore merci pour ton partage
Pardon d'abuser de ton temps