Résolution image PNG

ericTA

XLDnaute Occasionnel
Salut le forum,
petite question comme trouver la résolution d'une image PNG en VBA
Cordialement
Eric
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,
Salut Lone-Wolf,

Peux-tu essayer :

VB:
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

A+ à tous
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,

Pour le PPP : placer 168 en lieu et place de 31

VB:
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

A+ à tous
 

Lone-wolf

XLDnaute Barbatruc
Re Jean Claude

158 repend les noms, j'ai coché la case Extensions de noms de fichiers et là c'est OK.

VB:
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

Bonsoir à nous deux :p :D
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 989
Membres
101 856
dernier inscrit
Marina40