Excel macro to insert a picture with Redime

You want to save a macro that will allow you to insert a picture (located in a directory of your hard drive disk) in an active cell where you will be. This picture should be resized automatically to the size of the initial cell.

But also that it follows the height of the celle and of the column if you modify the width of the column and lines.

In that matter, you won’t have to do it manually again for every picture at every change you do with the height and the width of your columns.

Here is a macro that will do the job :

Public Sub inset_picture()
Dim ficimg As Variant
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choose the picture")  ' choice of the file name
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
    With Selection.ShapeRange
        .LockAspectRatio = False        ' original proportions when you resize
        .Top = ActiveCell.Top           ' cell height
        .Left = ActiveCell.Left         ' left of the cell
        .Height = ActiveCell.RowHeight  ' height of the cell
        .Width = ActiveCell.Width ' width of the cell
    End With
    With Selection
        .PrintObject = True             ' the object is printed at the same time of the document
        .Placement = xlMoveAndSize      ' way that the object is linked to the cellesmanière dont l'objet est lié aux cellules
    End With
End Sub