Sub versComm()
Dim Nom1 As String, Nom2 As String, repertoirePhoto As String
Dim Cell As Range, Sh As Shape
repertoirePhoto = "C:\Users\Pascal\Pictures\tousles mots\" ' Adapter
'On Error Resume Next ' pour évite l'arrêt de la macro si le nom ne correspond pas à une image valide
With Worksheets("base") ' à adapter à la feuille <==
For Each Cell In Selection
For Each Sh In .Shapes
If Sh.Type = 13 Then
If Sh.TopLeftCell.Address = Cell.Address Then Sh.Delete
End If
Next
Next
For Each Cell In Selection
Nom1 = Cell.Text
Nom2 = Cell.Text & Cell.Address(0, 0)
If Dir(repertoirePhoto & Nom1 & ".jpg") = Nom1 & ".jpg" Then
.Pictures.Insert(repertoirePhoto & Nom1 & ".jpg").Name = Nom2
.Shapes(Nom2).Left = Cell.Left
.Shapes(Nom2).Top = Cell.Top
tmp = .Shapes(Nom2).Height
.Shapes(Nom2).LockAspectRatio = msoTrue
.Shapes(Nom2).Height = Cell.Height
'si l'image déborde en largeur
If .Shapes(Nom2).Width > Cell.Width Then .Shapes(Nom2).Width = Cell.Width
End If
Next
End With
End Sub