Des photos dans un classeur

'### Constantes à adapter ###
Const FEUILLE_REF As String = "test"
Const CHEMIN As String = "c:\Dossier photos"
Const COL_REF As Long = 7
Const COL_PHOTO As String = "H"
'############################

Sub ChargePicture()
Dim S As Worksheet
Dim var
Dim i&
Dim A$
Dim R As Range
Dim PICT As Picture
On Error GoTo Erreur
Set S = Sheets(FEUILLE_REF)
S.Activate
var = S.Range("a1:iv" & [a65536].End(xlUp).Row & "")
Application.ScreenUpdating = False
For Each PICT In ActiveSheet.Pictures
  PICT.Delete
Next PICT
Rows("2:" & UBound(var, 1) & "").RowHeight = 39
For i& = 2 To UBound(var, 1)
  Set R = Range(COL_PHOTO & i& & "")
  A$ = CHEMIN & "\" & var(i&, COL_REF) & ".jpg"
  Set PICT = S.Pictures.Insert(A$)
  With PICT
    .Border.ColorIndex = 5
    .Top = R.Top
    .Left = R.Left
    .Width = R.Width
    .Height = R.Height
    .Placement = xlMoveAndSize
    .OnAction = "sansAction" 'Sans action : Evite la sélection de l'image
  End With
Next i&
Erreur:
Application.ScreenUpdating = True
End Sub

Sub sansAction(Optional dummy As Byte)
'---- Vide
End Sub