XL 2016 Remplacer un texte par une image

Sub Traduction()
Dim coef#, marge#, i&, ad$, s As Shape, cible$, txt$, L%, j%
coef = 6 'à adapter par tâtonnement
marge = 2 'à adapter par tâtonnement
Application.ScreenUpdating = False
With [A1].CurrentRegion
    For i = 2 To .Rows.Count
        .Cells(i, 5) = .Cells(i, 1)
        ad = .Cells(i, 5).Address
        For Each s In ActiveSheet.Shapes
            If s.TopLeftCell.Address = ad Then s.Delete 'RAZ
        Next s
        ad = .Cells(i, 4).Address
        For Each s In ActiveSheet.Shapes
            If s.TopLeftCell.Address = ad Then
                s.LockAspectRatio = msoTrue 'conserve le rapport hauteur/largeur
                s.Placement = 2 'déplacer sans dimensionner avec les cellules
                Exit For
            End If
        Next s
        If Not s Is Nothing Then
            cible = .Cells(i, 2)
            txt = .Cells(i, 5)
            L = Len(cible)
            For j = 1 To Len(txt)
                If Mid(txt, j, L) = cible Then
                    Set s = s.Duplicate 'copie la Shape
                    s.Width = coef * L + 2 * marge
                    s.Left = .Cells(i, 5).Left - marge + coef * j
1                   s.Top = .Rows(i).Top + .Rows(i).Height - s.Height
                    If s.Top < .Rows(i).Top + 4 Then .Rows(i).RowHeight = .Rows(i).RowHeight + 1: GoTo 1 'sécurité, la hauteur de ligne est ajustée
                End If
            Next j
        End If
    Next i
End With
End Sub

With Sheets("Feuil2").[A1].CurrentRegion