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
Un truc incompréhensible, j'ai supprimé le tif qui posait problème, ajouté 2 autres tif et ça a fonctionne parfaitement.
Puis re test avec l'ancien tif et tout fonctionne ... (???), il y a bien les 3 tif convertis par contre le msgbox de cet jamais lancé
 

Dudu2

XLDnaute Barbatruc
Si le message est placé comme indiqué et que tif fait partie de la 2ème ligne des paramètres il ne peut pas ne pas s'afficher.

Je ne sais pas pour ton code mais pour le mien:
1619417972841.png
 

re4

XLDnaute Occasionnel
Bonjour,
Je devais dormir hier soir... oui ça fonctionne
Test avec 3 tif poids = 165 Mo
Temps de conversion ~7'' soit un peu plus de 2" par tif
Poids du fichier Excel vierge 153 Ko
Poids du fichier Excel avec les 3 shaps 6284 Ko
La Dimension des shape n'influe pratiquement pas sur le poids final (test avec 50 et 400)
Un calcul approximatif donne ~2 Mo par shape ou miniature, c'est à mon avis encore trop sans compter les temps de calcul.
L'histoire n'est pas finie ;)
 

MJ13

XLDnaute Barbatruc
Re

Sinon, ce code permet normalement de réduire la taille des images dans une feuille.

Il n'est pas viable de mettre plus de 100 images sur une feuille sans quelle soit réduite ou sans qu'on ai des ralentissements , surtout pour des images provenant d'un fichier non compressé.

VB:
Public Adr
'Option Private Module
Sub A_Réduit_Taille_Images()
Application.ScreenUpdating = False
N = ActiveSheet.Pictures.Count
For i = N To 1 Step -1
'MsgBox ActiveSheet.Pictures(i).Address
'Adr = ActiveSheet.Shapes(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Adr = ActiveSheet.Pictures(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Réduit_Image_Gif
DoEvents
Application.StatusBar = i
Next
'A voir si beaucoup d'images en cas de ralentissements, ne pas le faire
'Affecte_Images_Macro1
Application.StatusBar = N
'Place les images liés à la cellule
ActiveSheet.DrawingObjects.Select
Selection.Placement = xlMoveAndSize

Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
Private Sub Réduit_Image_Gif()
On Error Resume Next
    Selection.Cut
  Range(Adr).Select
  'ex: pour environ 25 images environ PNG = 2.6 Mo, JPG = 3.6 GIF = 0.28 Mo
    ActiveSheet.PasteSpecial Format:="Image (GIF)", Link:=False, DisplayAsIcon _
        :=False
        Selection.ShapeRange.IncrementLeft 2
        Selection.ShapeRange.IncrementTop 2
End Sub
 

re4

XLDnaute Occasionnel
Re

Sinon, ce code permet normalement de réduire la taille des images dans une feuille.

Il n'est pas viable de mettre plus de 100 images sur une feuille sans quelle soit réduite ou sans qu'on ai des ralentissements , surtout pour des images provenant d'un fichier non compressé.

VB:
Public Adr
'Option Private Module
Sub A_Réduit_Taille_Images()
Application.ScreenUpdating = False
N = ActiveSheet.Pictures.Count
For i = N To 1 Step -1
'MsgBox ActiveSheet.Pictures(i).Address
'Adr = ActiveSheet.Shapes(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Adr = ActiveSheet.Pictures(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Réduit_Image_Gif
DoEvents
Application.StatusBar = i
Next
'A voir si beaucoup d'images en cas de ralentissements, ne pas le faire
'Affecte_Images_Macro1
Application.StatusBar = N
'Place les images liés à la cellule
ActiveSheet.DrawingObjects.Select
Selection.Placement = xlMoveAndSize

Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
Private Sub Réduit_Image_Gif()
On Error Resume Next
    Selection.Cut
  Range(Adr).Select
  'ex: pour environ 25 images environ PNG = 2.6 Mo, JPG = 3.6 GIF = 0.28 Mo
    ActiveSheet.PasteSpecial Format:="Image (GIF)", Link:=False, DisplayAsIcon _
        :=False
        Selection.ShapeRange.IncrementLeft 2
        Selection.ShapeRange.IncrementTop 2
End Sub
Merci, je vais tester
 

re4

XLDnaute Occasionnel
Dudu2,
Voir le pdf joint
Ces suggestions ne sont pas obligatoires mais peuvent éventuellement servir suivant l’utilisation.
Le formatage ou la mise en forme est personnel, c’est toi qui décides de l’appliquer ou pas.
A ta disposition si besoin de l'UseFormots "Mots Clés'' pour gagner du temps.

Cela implique certainement beaucoup de travail pour modifier, fais comme tu as envie :)
Merci
 

Pièces jointes

  • Suggestions.pdf
    163.2 KB · Affichages: 20

Dudu2

XLDnaute Barbatruc
Pour la taille des miniatures, faut que je voie.
Ce qui est bizarre c'est que copiées dans Photofiltre par exemple elles ne font que 10-20 Ko mais que l'Excel qui les contient se prend 500 Ko par image, peut-être plus.
Je vais essayer de les enregistrer réduites avant de les charger.

J'ai trouvé, grâce à @patricktoulon, un moyen de" convertir les Raw.
Il faut installer une logiciel, ImageMagick, donc ce n'est pas direct, il faut maniper un peu.
La conversion prend environ 3 secondes ce qui est long. Mais on obtient un résultat.
 

patricktoulon

XLDnaute Barbatruc
re
bonjour
Ce qui est bizarre c'est que copiées dans Photofiltre par exemple elles ne font que 10-20 Ko mais que l'Excel qui les contient se prend 500 Ko par image, peut-être plus.
non ce n'est pas bizarre c'est normal
une image insérée dans une feuille ou un load picture sur un activX c'est un bipmap qui est dans le bin du xls(m)

et le format bipmap est 10 fois plus lourd
 

re4

XLDnaute Occasionnel
Ce qui est bizarre c'est que copiées dans Photofiltre par exemple elles ne font que 10-20 Ko
Oui c'est ce que j'ai constaté aussi (post 117), c'est incompréhensible la miniature ne fait que 200px mais le fichier Excel fait presque le même poids que l'original, test 47 fichiers jpg = 69.30 Mo, fichier Excel 56.065 Mo !
C'est sûr que si l'on compresse avant on va gagner en poids
Exemple le même dossier de 47 photos compressées et redimensionnées en 200px dans sa plus grande def ne fait fait plus 461 Ko et le fichier Excel 514 Ko mais je ne traite que les jpg
 
Dernière édition:

re4

XLDnaute Occasionnel
re
bonjour

non ce n'est pas bizarre c'est normal
une image insérée dans une feuille ou un load picture sur un activX c'est un bipmap qui est dans le bin du xls(m)

et le format bipmap est 10 fois plus lourd
Bonjour patricktoulon, nos réponses se sont croisées, quelle idée d'utiliser encore des bipmap !
D'après Wikipédia : introduit avec Windows 3.0 en 1990. :)
Y a quand même un truc que je ne comprends pas, lorsque l'on redimensionne, le poids est identique à l'original redimensionné, si j'ai compris ton message ça devrait être multiplié par 10 puisque le jpg serait converti en bmp ?
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour re4 tu n'a rien compris
tu n'a pas le choix en fait
quand tu insert une picture jpeg ,c'est un bitmap dans le fichier xl
autrement dit si tu insert une picture de 200k par exemple
selon la chrominance en couleur ton fichier va peser 200k kilo *( entre 1 et 10) et tu n'y peux rien
et s
 

Dudu2

XLDnaute Barbatruc
une image insérée dans une feuille ou un load picture sur un activX c'est un bipmap qui est dans le bin du xls(m)
OK merci pour l'info. Je ne savais pas.

La solution c'est de ne pas insérer les miniatures dans la feuille en "statique", mais de ne le faire que pour les lignes visibles dynamiquement lorsqu'elles viennent à être affichées.

Ça va induire une certaine latence au scroll, latence qui d'ailleurs existe déjà le temps qu'Excel aille chercher ses petites choses de dessous les fagots pour afficher les images.

Évidemment en miniaturisation des d'images Raw cette latence sera significative.
Mais faut ce qu'il faut quand on veut ce qu'on veut !

Je verrai ça ce soir.
 
Dernière édition:

re4

XLDnaute Occasionnel
Re

Sinon, ce code permet normalement de réduire la taille des images dans une feuille.

Il n'est pas viable de mettre plus de 100 images sur une feuille sans quelle soit réduite ou sans qu'on ai des ralentissements , surtout pour des images provenant d'un fichier non compressé.

VB:
Public Adr
'Option Private Module
Sub A_Réduit_Taille_Images()
Application.ScreenUpdating = False
N = ActiveSheet.Pictures.Count
For i = N To 1 Step -1
'MsgBox ActiveSheet.Pictures(i).Address
'Adr = ActiveSheet.Shapes(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Adr = ActiveSheet.Pictures(i).TopLeftCell.Address
ActiveSheet.Pictures(i).Select
Réduit_Image_Gif
DoEvents
Application.StatusBar = i
Next
'A voir si beaucoup d'images en cas de ralentissements, ne pas le faire
'Affecte_Images_Macro1
Application.StatusBar = N
'Place les images liés à la cellule
ActiveSheet.DrawingObjects.Select
Selection.Placement = xlMoveAndSize

Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
Private Sub Réduit_Image_Gif()
On Error Resume Next
    Selection.Cut
  Range(Adr).Select
  'ex: pour environ 25 images environ PNG = 2.6 Mo, JPG = 3.6 GIF = 0.28 Mo
    ActiveSheet.PasteSpecial Format:="Image (GIF)", Link:=False, DisplayAsIcon _
        :=False
        Selection.ShapeRange.IncrementLeft 2
        Selection.ShapeRange.IncrementTop 2
End Sub
Je viens de tester, effectivement ça réduit le fichier Excel si l'on insère une photo le fichier passe de 1481 Ko à 438 Ko dans mon test.
Mais cela n'a aucune influence sur les shapes, voir aussi mail de PatrickToulon
 

re4

XLDnaute Occasionnel
Dudu2
Puisque on y est... sais-tu si l'on peut écrire dans les exifs d'un fichier photo jpg, dans titre, commentaires par exemple ? Bien sûr c'est possible avec les logiciels de traitement ou de catalogage photo mais avec une macro en vba ?
 

Discussions similaires

Statistiques des forums

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