Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
Dim chemin$, fichier, nom$, ext$, o As Object
If R.Column <> 3 Or R.Row = 1 Or R(1, 0) = "" Then Exit Sub
Cancel = True
chemin = ThisWorkbook.Path & "\" 'à adapter
ChDir chemin
fichier = Application.GetOpenFilename
If fichier = False Then Exit Sub
nom = Left(fichier, InStrRev(fichier, ".") - 1)
ext = Mid(fichier, Len(nom) + 1)
nom = Mid(nom, InStrRev(nom, "\") + 1)
Hyperlinks.Add R, fichier, TextToDisplay:=nom & ext
R(1, 2) = FileDateTime(fichier)
'R(1, 2) = Date 'pourquoi pas ?
'---fichier JPEG---
On Error Resume Next 'si l'image n'existe pas
Set o = Feuil2.Pictures(nom)
If o Is Nothing Then Exit Sub
fichier = chemin & nom & ".jpg"
o.CopyPicture
With Feuil2.ChartObjects.Add(0, 0, o.Width, o.Height).Chart
.Paste
.Export fichier, "JPG"
.Parent.Delete
End With
'---commentaire---
R.ClearComments
With R.AddComment
.Shape.Width = o.Width
.Shape.Height = o.Height
.Shape.Fill.UserPicture fichier
.Visible = False
End With
Kill fichier 'suppression du fichier JPEG
End Sub