Trouver la résolution d'une photo VBA
Résolu
-
-
-
Bonjour,
je viens solliciter l'aide du forum pour une macro VBa pour Excel.
mon problème:
-Je souhaite connaitre les propriétés des images d'un dossier pour les insérer dans un commentaire d'une cellule.
Je sais importer l'image, créer le commentaire.
Ce que je n'arrive pas à faire c'est la propriété "Exif" pour la hauteur et la largueur du JPEG (ou la résolution ), (je ne veut pas avoir à passer par le WIA puisque je dois pouvoir exécuter mon code depuis d'autre ordinateurs).
Voici un extrait de mon code:
Mon problème est dans les propriété .Widht et .Height , j'aimerai pouvoir utiliser les proportions originales de l'image.
le Msgbox est un exemple que j'ai trouvé pour récupérer la taille en Ko, est-ce qu'il existe la même chose pour la résolution de l'image?
D'avance merci (j'espère avoir été clair dans mon explication ...)
je viens solliciter l'aide du forum pour une macro VBa pour Excel.
mon problème:
-Je souhaite connaitre les propriétés des images d'un dossier pour les insérer dans un commentaire d'une cellule.
Je sais importer l'image, créer le commentaire.
Ce que je n'arrive pas à faire c'est la propriété "Exif" pour la hauteur et la largueur du JPEG (ou la résolution ), (je ne veut pas avoir à passer par le WIA puisque je dois pouvoir exécuter mon code depuis d'autre ordinateurs).
Voici un extrait de mon code:
Sub test_rezize_image()
Dim image, numero, ligne, projet As Variant
'Application.ScreenUpdating = False
projet = Left(ActiveWorkbook.Name, 3)
'On Error Resume Next
ligne = Range("C6").End(xlDown).Row
With Sheets(1).Range("D" & ligne)
.Comment.Visible = False
numero = Sheets(1).Range("C" & ligne).Value
image = "\\----\masse caisse\" & projet & " images\" & numero & ".JPG"
MsgBox (FileLen(image) / 1000 & "Ko")
'.Comment.Shape.Width = 500
'.Comment.Shape.Height = 350
End With
'Application.ScreenUpdating = True
End Sub
Mon problème est dans les propriété .Widht et .Height , j'aimerai pouvoir utiliser les proportions originales de l'image.
le Msgbox est un exemple que j'ai trouvé pour récupérer la taille en Ko, est-ce qu'il existe la même chose pour la résolution de l'image?
D'avance merci (j'espère avoir été clair dans mon explication ...)
A voir également:
- Trouver la résolution d'une photo VBA
- Google photo - Télécharger - Albums photo
- Trouver adresse mac - Guide
- Photo filtre 7 gratuit - Télécharger - Retouche d'image
- Google maps photo maison - Guide
- Partage photo - Guide
1 réponse
Bonjour,
avec l'objet iPicture sans doute : https://docs.microsoft.com/en-us/windows/win32/api/ocidl/nn-ocidl-ipicture?redirectedfrom=MSDN
Un exemple d'utilisation fait par michel_m (de mémoire, je n'ai pas retrouvé la discussion) :
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
avec l'objet iPicture sans doute : https://docs.microsoft.com/en-us/windows/win32/api/ocidl/nn-ocidl-ipicture?redirectedfrom=MSDN
Un exemple d'utilisation fait par michel_m (de mémoire, je n'ai pas retrouvé la discussion) :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim chemin As String
Dim design As String, image As String
Dim pict As IPictureDisp, rapport As Double
If Not Intersect(Target, Range("A2:A" & Range("B1").End(xlDown).Row)) Is Nothing And Target.Count = 1 Then
design = Target.Offset(0, 1)
If design = "aucune" Then
Sheets(1).Image1.Picture = LoadPicture("")
Else
chemin = ThisWorkbook.Path & "\" 'A ADAPTER
'prend en compte le format de la photo
If Dir(chemin & design & ".png") <> "" Then image = design & ".png"
If Dir(chemin & design & ".jpg") <> "" Then image = design & ".jpg"
If Dir(chemin & design & ".jpeg") <> "" Then image = design & ".jpeg"
If Dir(chemin & design & ".gif") <> "" Then image = design & ".gif"
'charge la photo
On Error GoTo inconnu
Set pict = LoadPicture(chemin & image)
'teste format image ou portrait
rapport = Round((pict.Width) / 21.16, 0) / Round((pict.Height) / 21.16, 0)
'construit et remplit la forme au format 2/3
With Sheets(1).Image1
.PictureSizeMode = 3
.Picture = pict
If rapport < 1 Then
.Height = 360
.Width = 240
Else
.Height = 240
.Width = 360
End If
'.Select
End With
End If
End If
Set pict = Nothing
Exit Sub
inconnu:
Sheets(1).Image1.Picture = LoadPicture("")
MsgBox "Nom de photo inconnu", vbCritical, "galerie photo"
End Sub
eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.