VBA: trouver la hauteur et la largeur d’une image



Quelque soit la raison pour le faire, sachez que grâce à VBA, vous pouvez facilement obtenir l'information sur les dimensions (hauteur et largeur) d'un fichier image.  Vous pouvez ainsi vérifier si la taille de vos photos est compatible avec votre créateur d'albums photo en ligne, vous pouvez tester si la photo/image est verticale (portrait) ou horizontale (paysage), vous pouvez tester s'il s'agit d'une photo d'origine ou d'un rapetissement,…

Pour cela, je vous propose trois fonctions VBA prêtes à l'emploi, comme d'habitude, avec un simple copier/coller dans votre projet.

Une qui vous donne les mensurations en format "hauteur x largeur", une qui renvoie le chiffre correspondant à la hauteur en pixels de l'image et une qui renvoie un chiffre avec la largeur en pixels de l'image. Les deux dernières seront utiles si vous devez faire les tests ou les comparaisons chiffrées (plus grande que…, plus petite que…).

Ces trois fonctions utilisent comme argument le nom de fichier image en question (ainsi que le chemin vers ce fichier). Elles sont utilisables telles quelles – il suffit de les copier/coller dans votre projet. Un exemple d'utilisation se trouve à la fin de cet article.

Trouver les dimensions d'une image en pixels

Cette fonction VBA vous donne comme résultat les deux dimensions en pixels de l'image en tant que chaîne de caractères (sous format: "hauteur x largeur").

Comme vous pouvez le constater, on fait appel à la propriété .ExtendedProperty("Dimensions") du fichier image. Le résultat doit encore être traité car brut, il contient des caractères indésirables. Ce "nettoyage" se fait à la fin du code.

Public Function DimensionsImage(Fichier As String)
'par Excel-Malin.com ( http://excel-malin.com )

On Error GoTo Erreur

Dim objShell As Object
Dim objDossier As Object
Dim objFichier As Object

Dim ImageDossier As Variant
Dim ImageFichier As Variant

ImageFichier = Mid(Fichier, InStrRev(Fichier, "\") + 1)
ImageDossier = Left(Fichier, Len(Fichier) - Len(ImageFichier))

Set objShell = CreateObject("Shell.Application")

Set objDossier = objShell.Namespace(ImageDossier)
Set objFichier = objDossier.ParseName(ImageFichier)

DimensionsI = CStr(objFichier.ExtendedProperty("Dimensions"))
DimensionsI = Left(DimensionsI, Len(DimensionsI) - 1)
DimensionsImage = Right(DimensionsI, Len(DimensionsI) - 1)

Set objFichier = Nothing
Exit Function
Erreur:
    DimensionsImage = ""
End Function

Si une erreur survient, le résultat de la fonction sera une chaîne de caractères vide…

Trouver la hauteur en pixels d'une image

Cette fonction fait également appel à propriété .ExtendedProperty("Dimensions"). Les dimensions ainsi obtenues sont traitées différemment que dans la fonction précédente – on en extrait la valeur numérique de la hauteur de l'image. Le résultat de cette fonction est un nombre de type Single.

Public Function ImageHauteur(Fichier As String) As Single
'par Excel-Malin.com ( http://excel-malin.com )

On Error GoTo Erreur

Dim objShell As Object
Dim objDossier As Object
Dim objFichier As Object

Dim ImageDossier As Variant
Dim ImageFichier As Variant

ImageFichier = Mid(Fichier, InStrRev(Fichier, "\") + 1)
ImageDossier = Left(Fichier, Len(Fichier) - Len(ImageFichier))

Set objShell = CreateObject("Shell.Application")

Set objDossier = objShell.Namespace(ImageDossier)
Set objFichier = objDossier.ParseName(ImageFichier)

ImageDimensions = Replace(CStr(objFichier.ExtendedProperty("Dimensions")), " ", "")
SeparatorPosition = InStr(1, ImageDimensions, "x")

ImageH = Mid(ImageDimensions, SeparatorPosition + 1)
If IsNumeric(ImageH) = False Then ImageH = Left(ImageH, Len(ImageH) - 1)

ImageHauteur = CSng(ImageH)

Set objFichier = Nothing
Exit Function
Erreur:
    ImageHauteur = ""
End Function

 

Trouver la largeur en pixels d'une image

Cette fonction VBA fonctionne de la même manière que la précédente mais cette fois, elle va renvoyer la largeur de l'image en pixels…

Public Function ImageLargeur(Fichier As String) As Single
'par Excel-Malin.com ( http://excel-malin.com )

On Error GoTo Erreur

Dim objShell As Object
Dim objDossier As Object
Dim objFichier As Object

Dim ImageDossier As Variant
Dim ImageFichier As Variant

ImageFichier = Mid(Fichier, InStrRev(Fichier, "\") + 1)
ImageDossier = Left(Fichier, Len(Fichier) - Len(ImageFichier))

Set objShell = CreateObject("Shell.Application")

Set objDossier = objShell.Namespace(ImageDossier)
Set objFichier = objDossier.ParseName(ImageFichier)

ImageDimensions = Replace(CStr(objFichier.ExtendedProperty("Dimensions")), " ", "")
SeparatorPosition = InStr(1, ImageDimensions, "x")

ImageL = Left(ImageDimensions, SeparatorPosition - 1)
If IsNumeric(ImageL) = False Then ImageL = Right(ImageL, Len(ImageL) - 1)

ImageLargeur = CSng(ImageL)

Set objFichier = Nothing
Exit Function
Erreur:
    ImageLargeur = ""
End Function

 

Example d'utilisation des trois fonctions

Pour terminer, voici une petite procédure pour illustrer l'utilisation des fonctions présentées dans cet article.

Sub ExempleFonctionsTailleImage()
'par Excel-Malin.com ( http://excel-malin.com )

On Error GoTo Erreur

Dim MonImage As String

MonImage = "C:\MonDossier\MonImage.jpg" '<- remplacez par le chemin vers une de vos images 'la première fonction MsgBox "Les dimensions de l'image (en pixels): " & DimensionsImage(MonImage) 'info sur la hauteur If ImageHauteur(MonImage) > 200 Then
    MsgBox "La hauteur de l'image est supèrieure à 200 pixels..."
Else
    MsgBox "La hauteur de l'image est infèrieure à 200 pixels..."
End If

'info sur la largeur
If ImageLargeur(MonImage) > 400 Then
    MsgBox "La largeur de l'image est supèrieure à 400 pixels..."
Else
    MsgBox "La largeur de l'image est infèrieure à 400 pixels..."
End If

Exit Sub

Erreur:
    MsgBox "Une erreur est survenue..."
End Sub

Astuce: Si vous voulez traiter de nombreuses photos/images (tri selon la taille etc.), il vous suffit de combiner ces fonctions avec des boucles et vous obtiendrez un outil  étonnamment puissant capable de vérifier dizaines de photos par minute…

Conclusion

Il ne s'agit pas de fonctions bien compliquées – il faut surtout savoir qu'une telle fonction existe en VBA. On n'a pas souvent le réflexe d'imaginer qu'Excel peut être utilisé pour gérer des photos.

Pour garantir un meilleur résultat, vous pouvez, avant de tester la taille des images, vérifier si le fichier existe. Vous éviterez ainsi des erreurs au cas où le fichier que vous voulez tester n'existe pas (ceci est surtout utile si vous voulez utiliser cette technique pour gérer les photos en masse).

 

1 0



Laissez un commentaire

Votre adresse de messagerie ne sera pas publiée.