Comment afficher une image au survol d'une cellule

Sub creer_image_survol()
Dim chemin As String, Col As Byte, Lig As Byte, Fin As Integer, Cptr As Integer
Dim design As String, image As String
Dim pict As IPictureDisp

chemin = ThisWorkbook.Path & "\"
Col = Range("start").Column
Lig = Range("start").Row
Fin = Range("start").End(xlDown).Row
For Cptr = Lig To Fin
     image = Cells(Cptr, Col)
     design = chemin & image
     'prend en compte le format de la photo
     If Dir(design & ".png") <> "" Then image = image & ".png"
     If Dir(design & ".jpg") <> "" Then image = image & ".jpg"
     If Dir(design & ".jpeg") <> "" Then image = image & ".jpeg"
     If Dir(design & ".gif") <> "" Then image = c & ".gif"
     Set pict = LoadPicture(chemin & image)

     'construit et remplit le commentaire
      With Cells(Cptr, Col)
          .ClearComments
          .AddComment
          With .Comment.Shape
              .Fill.UserPicture chemin & image
              .LockAspectRatio = msoFalse
              .Height = 300
              .Width = 300
          End With
          .Comment.Visible = False
      End With
Next

End Sub

.Height = 300
.Width = 300