Insertion et dimensionnement image dans une cellule

Bonjour,

J'ai trouver une macro qui me permet de redimensionner une image dans ca cellule.

Le problème, lorsque j'augmente la taille de le cellule en hauteur, l'image ne se redimensionne pas avec la cellule.

Manuellement, lorsque dans les propriété de l'image, je coche "déplacer et redimensionné avec les cellules", lorsque j'augmente la taille de le cellule en hauteur, l'image suis la hauteur de la cellule mais ne garde pas les proportion en largeur.

Je me retrouve donc avec un image allongé.

Quelqu'un aurait-il une idée pour que mon image conserve ses proportions automatiquement lorsque je modifie la dimension de la cellule?

L'Ideal, serai d'insérer un image via une macro et que celle-ci se positionne au centre de la cellule sélectionné, et bien sur quelle suive la dimension de celle-ci lorsque que je le modifie la cellule.

Ci-dessous le code provisoire qui me permet uniquement de redimensionner image à la taille actuel de la cellule.

Public Sub DimImage()
On Error GoTo NOT_SHAPE
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
With Selection
PicWtoHRatio = .Width / .Height
End With
With Selection.TopLeftCell
CellWtoHRatio = .Width / .RowHeight
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is > 1
With Selection
.Width = .TopLeftCell.Width
.Height = .Width / PicWtoHRatio
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight
.Width = .Height * PicWtoHRatio
End With
End Select
With Selection
.Top = .TopLeftCell.Top
.Left = .TopLeftCell.Left
End With
Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro."
End Sub

Je joint également le fichier

Merci par avance à tous les volontaires

LMARCO

TEST