Trouver la résolution d'une photo VBA
Résolu/Fermé
pou pouille
Messages postés
207
Date d'inscription
mardi 20 octobre 2009
Statut
Membre
Dernière intervention
20 juillet 2012
-
18 juil. 2012 à 15:45
pou pouille Messages postés 207 Date d'inscription mardi 20 octobre 2009 Statut Membre Dernière intervention 20 juillet 2012 - 20 juil. 2012 à 15:49
pou pouille Messages postés 207 Date d'inscription mardi 20 octobre 2009 Statut Membre Dernière intervention 20 juillet 2012 - 20 juil. 2012 à 15:49
A voir également:
- Trouver la résolution d'une photo VBA
- Traduction photo - Guide
- Cette photo n’a pas été prise cette année. trouvez la date, l'heure et avec quel modèle d'appareil photo elle a été prise. ✓ - Forum Graphisme
- Photo filtre gratuit - Télécharger - Retouche d'image
- Flouter une photo - Guide
- Trouver adresse mac - Guide
1 réponse
eriiic
Messages postés
24513
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
25 mars 2023
7 168
Modifié par eriiic le 18/07/2012 à 18:14
Modifié par eriiic le 18/07/2012 à 18:14
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.
19 juil. 2012 à 16:12
20 juil. 2012 à 15:49
Pou Pouille