Option Explicit
Sub Voir_Résolution()
Dim Sh As Object
Dim Fichier As Object
Dim Répertoire As Object
Set Sh = CreateObject("Shell.Application")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un répertoire..."
If .Show Then
Set Répertoire = Sh.Namespace(.SelectedItems(1))
For Each Fichier In Répertoire.Items
MsgBox Fichier.Name & " " & Répertoire.GetDetailsOf(Fichier, 31)
Next Fichier
End If
End With
End Sub
...Qu'entends-tu par résolution de l'image
Option Explicit
Sub Voir_Résolution()
Dim Sh As Object
Dim Fichier As Object
Dim Répertoire As Object
Set Sh = CreateObject("Shell.Application")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un répertoire..."
If .Show Then
Set Répertoire = Sh.Namespace(.SelectedItems(1))
For Each Fichier In Répertoire.Items
MsgBox Fichier.Name & " " & Répertoire.GetDetailsOf(Fichier, 168)
Next Fichier
End If
End With
End Sub
Option Explicit
'Cocher la case Extensions de noms de fichiers
Sub Voir_Résolution()
Dim Sh As Object
Dim Fichier As Object
Dim Répertoire As Object
Dim x As Long
Dim dimensions, nom
Set Sh = CreateObject("Shell.Application")
[A2:B100].ClearContents
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisir un répertoire..."
If .Show Then
Set Répertoire = Sh.Namespace(.SelectedItems(1))
For Each Fichier In Répertoire.Items
x = x + 1
nom = Fichier.Name
dimensions = Répertoire.GetDetailsOf(Fichier, 31)
Cells(x + 1, 1) = nom
Cells(x + 1, 2) = dimensions
Next Fichier
End If
End With
[A2:B100].Sort [A2], xlAscending
End Sub