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

 

[re4]

Bonjour,
Je n'ai pas la compétence pour faire les basiques modifications sur ce type de programmation (sophistiquée ,-)
Je m'en sort mieux avec du vba plus basique... dans le style de l'enregistreur de macro.
Si tu as le temps :
Décaler les tires en ligne 2
Ne pas afficher le chemin par défaut en colonne A, il sera dans les prérequis
Toutes les colonnes devraient commencer en A avec ou sans les vignette
Petite formule en A1 pour compter le nombre de ligne non vide, ça je sais faire...
J'ai modifié les propriétés des boutons pour qu'ils ne se déplacent pas avec la largeur des colonnes

Merci

 

[re4]

Hello,
C'est bon j'y suis arrivé

Edit:
Je viens de voir que ''Application.OperatingSystem'' donne le nom du système est ce utile pour ton code pour en déterminer la version ? Est-ce plus fiable si Microsoft décidait de changer encore quelques noms de tags ?

 

[re4]

Bonjour,
Bizarrement, ''Orientation tags 270" n'est pas fiable à 100% et ne fonctionne pas si les photos ont été modifiées par certains logiciels.
En utilisent Dimensions, tag31, il serait possible de déterminer si la photo est en paysage ou portrait ou carrée mais il y a un caractère caché (Unicode 8234) impossible à supprimer j'ai essayé Epurage, supprespace rien n'y fait.
Impossible donc d'extraire les valeurs en numérique.
Il a bien le code joint qui fonctionne mais c'est très lent...
Certainement d'autres solutions existent
Merci

Sub Supp_Unicode_invisibles()
Dim s1 As String, s2 As String, c As String, i As Long, iAsc As Integer
With ActiveSheet: Lig = .Cells(.Rows.Count, 2).End(xlUp).Row: End With
For x = 3 To Lig
For Z = 1 To Lig
s1 = Cells(x, Z).Value
s2 = ""
For i = 1 To Len(s1)
   c = Mid(s1, i, 1)
    iAsc = AscW(c)
    If iAsc <= 1000 Then
    s2 = s2 & c
  End If
Cells(x, Z).Value = s2
Next i
Next Z
Next x
End Sub

 

[Dudu2]

''Orientation tags 270" n'est pas fiable à 100% et ne fonctionne que si les photos n'ont pas été modifiées.

Je me souviens avoir eu des soucis avec le Tag orientation avec Photofiltre qui ne gère pas ce tag en modification contrairement à la visionneuse de photos Windows lorsqu'on y change l'orientation.
Je ne suis pas sûr que la dimension de l'image en indique l'orientation, mais je te laisse voir ça.

J'ai beaucoup de mal avec Unicode dont je n'ai pas compris exactement le fonctionnement et surtout comment les programmes font pour distinguer un caractère Unicode dans un flot de caractères "normaux". La description Wikipédia est imbuvable. Et je ne comprends pas non plus pourquoi un tel caractère serait présent dans un Tag de dimensions.

Je ne sais pas trop ce que tu cherches à faire avec les boucles sur x et sur Z qui tournent sur les lignes. Ça n'a pas tellement de sens. Si tu veux te débarrasser d'un codage Unicode essaie Chaine = StrConv(Chaine, vbFromUnicode).

 

[re4]

Merci Dudu2 d'être encore à l'écoute.

Je vais essayer d'être plus clair
- Pour les boucles c'était un test sur le tableau pour scanner toutes les cellules, c'est empirique et il y a certainement une autre méthode.
2500 x 1000 = Dimensions, un stxt(A6;1;4) donne 250, il y a bien un truc avant le 2
- En exemple, j'ai trouvé le code Unicode avec la formule UNICODE(A6) => 8134
- Avec la macro du post 48 l'Unicode donne un résultat de 48 et je peux extraire la résolution H ou V avec un simple stxt() et le résultat est numérique
-l'idée est de comparer H et V pour en déterminer l'orientation sans erreur
- Pour StrConv(Chaine, vbFromUnicode). je ne sais comment l'insérer mais je vais chercher ,-)

 

[Dudu2]

En effet, il y a un ou des caractères Unicode dans les tags. J'essaie de voir comment s'en débarrasser.

 

[re4]

Le code ci-dessous me semble bien fonctionner, avec stxt() j'obtiens les bonnes valeurs numériques

Private Sub str()
Dim strValue As String
strValue = Range("A12").Value
Range("a12").Value = Mid(strValue, 2)
'Range("h1").Value = StrReverse(strValue)
End Sub

 

[Dudu2]

Comme tu préfères.
J'ai retiré les caractères Unicode en début et en fin. Je ne pense pas qu'il y en ait au milieu de la valeur des Tags. Voir fichier en Post #44.

 

[re4]

Super, ça fonctionne mais en fait ça ne converti pas vraiment en numérique les valeurs sont à gauche .
L'idée est de substituer les valeurs dans la colonne "Orientation" par une formule et pour simplifier du type si(valeurH>valeurV; "Paysage";"Portrait"), l'on pour y ajouter ""Carré" et à droite dans la même cellule le ratio positif du type R : 1.5
Ca je sais faire avec un formule mais pas à l'intégrer dans ton code.
Encore maerci

 

[Dudu2]

J'ai codé ce que tu souhaites voir comme valeur.
Fichier en Post #44.

 

[re4]

Bonjour
Pour le fun
Ce qu’il faudrait en colonne F & G :

A	B	C	D	E	F	G
Tag #31 Dimensions	Tag #176 Largeur	Tag #178 Hauteur	Formule Extractor	Formule Extractor	Ratio	Tag #270 Orientation
3000 x 2000	2362 pixels	1674 pixels	3000	2000	1,50	Paysage
2000 x 3000	1280 pixels	1920 pixels	2000	3000	1,50	Portrait
1080 x 1080	1920 pixels	1920 pixels	1080	1080	1,00	Carré
1920 x 1080	1920 pixels	1080 pixels	1920	1080	1,78	Paysage

Les colonnes B & C sont à titre d'exemple,
Les colonnes D & E ne devrait pas exister, mais besoin pour mon calcul

Y a certainement plus simple mais voici ma démarche très empirique pour arriver au résultat espéré pour les colonne F a G.

1- Base ‘’Tag #31 Dimensions’’ Ex :cellule A3 => 3000 x 2000 d’après le dernier fichier du post 44
(suppression des Unicodes)

2 -De la colonne A vers D & E extraction des chiffres avant et après le"x" => Ex : D3=3000 & E3=2000
Par formule et ce code ‘’

'Formule pour avant le x (exemple 3000 x 2000 ) =Extractor(B3;"x";0)
'Formule pour après le x (exemple 3000 x 2000 ) =Extractor(C3;"x";1)
Function Extractor(r As Range, Sep$, n&)
Extractor = Split(r.Text, Sep)(n)
End Function

3 - Calcul du ‘Ratio’, insérer une colonne à droite de la colonne ‘’Tag #31 Dimensions’’.

4 - Il faut convertir les données en D & E en numérique par CNUM
=SI(MAX(CNUM(D3);CNUM(E3))=CNUM(D3);CNUM(D3)/CNUM(E3);((CNUM((E3)/CNUM(D3)))))

5 - En colonne ‘’ "Tag #270 Orientation" remplacement du l’extraction originale par
‘Paysage’ ou ‘Portrait’ ou ‘Carré’
=SI(CNUM(D3)=CNUM(E3);"Carré";SI(CNUM(D3)>CNUM(E3);"Paysage";"Portrait"))

Idéalement ça devrait être fait par une routine mais je ne sais pas faire ou alors peut-être que je l’aurai fini à la fin du confinement

Si tu as le temps et l’envie de te replonger dedans
Merci

 

[Dudu2]

Pour ce qui concerne le Tag Orientation, il me semble que c'est déjà codé comme ça (voir fichier en Post #44) sauf que tu veux maintenant séparer l'Orientation et le Ratio dans des colonnes différentes, c'est bien ça ?

Faire une colonne à part qui ne soit pas un Tag est certes possible mais ce n'est pas si simple.
Ça complique pas mal la gestion des colonnes car il faut décaler après la colonne ratio dont on ne sait pas où elle se trouve à priori.
Ou alors il faut affecter dans le code un n° de Tag spécial au Ratio et le traiter partout comme tel.
La colonne Ratio implique qu'on récupère les Dimensions qu'elles soient ou pas demandées dans la liste, ce qui implique encore un traitement spécial pour aller chercher les Dimensions.

Je peux essayer de le faire si la solution déjà en place ne te convient pas à 100%.
Pour information le fichier en Post #44 a été modifié pour améliorer la gestion des hauteurs de lignes et pour inclure des mots-clés de sélection des fichiers.

 

[re4]

Bonsoir, encore merci de t'impliquer dans ce projet, ce que je demande c'est du fignolage, tu y as déjà beaucoup travaillé.

D'abord je te demande pardon, je me suis planté dans le nommage du fichier du post 44 et j'utilisais l'ancien version.
Je viens de tester (je n'ai rien modifié)
1- Le trie sur Colonne donne une erreur à NomTableauTags (Pop up : Variable non définie), c'est le même PC

2- Dans la colonne Dimension la Dimension et le ratio ne s'affichent pas

Pour ce qui concerne le Tag Orientation, il me semble que c'est déjà codé comme ça

Ca ne s'affiche pas... bizarre, j'ai bien vu ton code à la ligne Fabrique la valeur du Tag Orientation

sauf que tu veux maintenant séparer l'Orientation et le Ratio dans des colonnes différentes

Oui, comme, si possible dans l'exemple du tableau et ajouter une colonne juste avant ou après (si l'on trouve une colonne Dimensions ajouter une colonne Ratio

Toutes les formules que j'ai posté fonctionnent c'est avec elles que j'ai crée le tableau mais elles ne te sont pas de grandes utilités ! ,-)

Pour info :
Pour l'insertion d'une colonne après un tags défini (ici "Tag #31" & Chr(10) & "Dimensions"), j'ai trouvé le code ci-dessous qui fonctionne bien

'x insère colonne
Sub InsertCol()
Dim O As Object 'déclare la variable O (Onglet)
Dim r As Range 'déclare la variable R (Recherche)
Dim COL As Byte 'déclare la variable COL (COLonne)

Set O = Sheets("Liste") 'définit l'onglet O (à adapter)
Set r = O.Rows(2).Find("Tag #31" & Chr(10) & "Dimensions", , xlValues, xlWhole)  ' A adapter
If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    COL = r.Column 'définit la colonne COL
    Columns(COL + 1).Insert shift:=xlToRight 'insère une colonne après la colonne COL
End If 'fin de la condition
End Sub

Mais vu ton niveau ça te fera gagner la saisie si tu l'utilises ,-)

 

[Dudu2]

1- Le trie sur Colonne donne une erreur à NomTableauTags et bloque la macro, c'est le même PC (je n'ai rien modifié)

Petite erreur de ma part en recopiant les constantes de l'autre fichier. La constante doit être Public.

2- Dans la colonne Dimension le ratio ne s'affiche pas, je n'ai pas regardé le code comment fais-tu pour le déterminer ?

Le Ratio s'affiche (s'affichait) dans la colonne Orientation comme demandé dans le Post #54. Pas dans la colonne Dimensions.

Pour l'insertion d'une colonne après un tags défini (ici "Tag #31" & Chr(10) & "Dimensions"), j'ai trouvé le code ci-dessous qui fonctionne bien

Merci pour le code d'insertion d'une colonne.

J'ai considéré que le Ratio était un Tag standard (Tag utilisateur) ajouté aux Tags système et lui ai attribué le #321.
De sorte qu'on peut le citer dans la liste comme les autres.
Bien sûr les Dimensions sont extraites indépendamment de la présence du Tag Dimensions dans la liste pour calculer le Ratio.
Les valeurs de Tags Ratio et Orientation sont issues du code et non du fichier.

Reprendre le fichier en Post #44.

 

[re4]

Alors là bravo aussitôt dit aussitôt fait
Y a un petit souci si on laisse les tags d'origine (sans modif) le ratio s'affiche dans une colonne mais si l'on sélectionne que quelques tags (3 pour le test, Dimensions, Orientation, Prise de vue) le ratio n'apparait pas
Merci pour tout