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
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
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
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
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
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…
- Gestion des fichiers en VBA
- Compresser et décompresser avec ZIP en VBA
- Débloquer VBA dans les fichiers en provenance d'internet
- Comment utiliser RECHERCHEV directement en VBA (cela vaut aussi pour d'autres fonctions Excel)
- Liste de toutes les fonctions VBA
- Bibliothèque des codes sources VBA en français prêts à l'emploi
