Trouver la résolution d'une photo VBA
Résolu
pou pouille
Messages postés
212
Statut
Membre
-
pou pouille Messages postés 212 Statut Membre -
pou pouille Messages postés 212 Statut Membre -
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 ...)
--
la théorie et la pratique c'est la même chose...enfin en théorie
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 ...)
--
la théorie et la pratique c'est la même chose...enfin en théorie
A voir également:
- Trouver la résolution d'une photo VBA
- Trouver adresse mac - Guide
- Google photo - Télécharger - Albums photo
- Légender une photo - Guide
- Ou trouver la corbeille - Guide
- Réduire résolution image - 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.
Pou Pouille