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

re4

XLDnaute Occasionnel
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

VB:
'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
 
Dernière édition:
Solution
OK. Si le titre de la colonne E est "Ordre" la formule serait mieux avec =SI([@Ordre]>0;"Oui";"Non")
C'est une syntaxe propre aux tableaux structurés (le symbole @ représente la ligne courante).

Mais à partir du moment où c'est le chiffre qui déclenche l'affichage, on peut se passer de la colonne "Afficher".
Voici une version qui, selon ta préférence, utilise la colonne Ordre (de classement) dont la gestion requiert la ré-attribution des numéros et le tri du tableau (bouton dédié) en cas de modification de classement.
Pour le centrage vertical des lignes tu as une idée ?
Une instruction VBA.

Fichier mis à jour 21/04/2021 14h32

re4

XLDnaute Occasionnel
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

1617340765087.png
 
Dernière édition:

re4

XLDnaute Occasionnel
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 ?
 
Dernière édition:

re4

XLDnaute Occasionnel
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

VB:
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
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
''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

XLDnaute Occasionnel
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 ,-)
 
Dernière édition:

re4

XLDnaute Occasionnel
Le code ci-dessous me semble bien fonctionner, avec stxt() j'obtiens les bonnes valeurs numériques
VB:
Private Sub str()
Dim strValue As String
strValue = Range("A12").Value
Range("a12").Value = Mid(strValue, 2)
'Range("h1").Value = StrReverse(strValue)
End Sub
 

re4

XLDnaute Occasionnel
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
 

re4

XLDnaute Occasionnel
Bonjour
Pour le fun
Ce qu’il faudrait en colonne F & G :
ABCDEFG
Tag #31
Dimensions
Tag #176
Largeur
Tag #178
Hauteur
Formule
Extractor
Formule
Extractor
RatioTag #270
Orientation
3000 x 20002362 pixels1674 pixels300020001,50Paysage
2000 x 30001280 pixels1920 pixels200030001,50Portrait
1080 x 10801920 pixels1920 pixels108010801,00Carré
1920 x 10801920 pixels1080 pixels192010801,78Paysage
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 ‘’
VB:
'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
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
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 ?
1617824735138.png


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

XLDnaute Occasionnel
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

VB:
'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 ,-)
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
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.
 
Dernière édition:

re4

XLDnaute Occasionnel
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
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 796
Membres
101 817
dernier inscrit
carvajal