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,…

Sommaire

Trouver les dimensions d'une image en pixels en VBA
Trouver la hauteur en pixels d'une image
Trouver la largeur en pixels d'une image
Example d'utilisation des trois fonctions VBA
Conclusion
Pour aller plus loin en VBA

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 en VBA

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 ( https://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

Public Function DimensionsImage(Fichier As String)

'par Excel-Malin.com ( https://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 ( https://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

Public Function ImageHauteur(Fichier As String) As Single

'par Excel-Malin.com ( https://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

Ce code VBA fonctionne de la même manière que la fonction précédente. Cette fois, la fonction va renvoyer comme résultat la largeur de l'image en pixels…

Public Function ImageLargeur(Fichier As String) As Single
'par Excel-Malin.com ( https://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

Public Function ImageLargeur(Fichier As String) As Single

'par Excel-Malin.com ( https://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 VBA

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 ( https://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

Sub ExempleFonctionsTailleImage()

'par Excel-Malin.com ( https://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 une quantité importante des photos/images (les trier 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 des 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).

Pour aller plus loin en VBA

Et voici quelques articles sur VBA qui pourraient bien vous servir pour vos macros…

Laissez un commentaire Annuler la réponse

2 commentaires sur “VBA: trouver la hauteur et la largeur d’une image”

2 commentaires

Lu6Fer
14/10/2023, 17:25

Ca marche pas !!

Répondre
- Martin Hudec ( Excel-Malin.com ) Auteur de l’article
  15/10/2023, 16:20
  
  Bonjour, vous pouvez être plus spécifique?
  Car je viens de le tester et mon code fonctionne parfaitement:
  
  Répondre

Trouver les dimensions d'une image en pixels en VBA

Trouver la hauteur en pixels d'une image

Trouver la largeur en pixels d'une image

Example d'utilisation des trois fonctions VBA

Conclusion

Pour aller plus loin en VBA

Auteur

Martin Hudec ( Excel-Malin.com )

Laissez un commentaire Annuler la réponse

2 commentaires sur “VBA: trouver la hauteur et la largeur d’une image”