Sub placeLaShapeBleue() 'test avec une shape
Dim shap
Set shap = ActiveSheet.Shapes("shapebleue")
PlaceThePictureInCenterRange [C4].MergeArea, shap, 50 ' 50% de la taille de la plage de destination de 0 à 100
End Sub
Sub PlaceThePictureInCenterRange(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100) 'la marge exprime un pourcentage de 1 à x%
Dim Ratio#, Wx#, Yx#
Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 100)
Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
With Obj
If TypeName(Obj) = "Shape" Then .LockAspectRatio = msoTrue Else .ShapeRange.LockAspectRatio = msoTrue
.Width = .Width * Ratio
.Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
.Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
End With
End Sub