Option Explicit
Const Coef! = 3 'coefficient d'agrandissement, modifiable
Sub Agrandir()
Dim ShpMin As Shape, Cel As Range, WshSrc As Worksheet, ShpSrc As Shape
If IsError(Application.Caller) Then Exit Sub 'sécurité
Set ShpMin = Me.Shapes(Application.Caller)
Set Cel = ShpMin.TopLeftCell
If ShpMin.Height > Cel.Height Then
ShpMin.Height = Cel.Height
Else
' Set WshSrc = ThisWorkbook.Worksheets(Split(ShpMin.Name)(1))
Set WshSrc = ThisWorkbook.Worksheets(CStr(Cel.EntireRow.Columns(1).Value))
Set ShpSrc = WshSrc.Shapes("Image 1")
ShpSrc.Copy
Cel.Select
Me.Paste
ShpMin.Delete
Set ShpMin = Selection.ShapeRange(1)
ShpMin.Name = "Image " & WshSrc.Name
ShpMin.Height = Cel.Height * Coef
ShpMin.OnAction = Me.CodeName & ".Agrandir"
Cel.Activate
[A1].Copy [A1]: End If 'vide le presse-papiers
End Sub