XL 2013 Centrer une image (.jpg ou .png) verticalement et horizontalement dans une cellule excel.

Sub test()
    centreAllImageonPlage Sheets(1).Range("A1:d6")
End Sub


Sub centreAllImageonPlage(plage)
    Dim pict As Shape, cel As Range
    For Each pict In plage.Parent.Shapes
        Set cel = pict.TopLeftCell
        If Not Intersect(cel, plage) Is Nothing Then
            pict.Left = cel.Left + ((cel.Width - pict.Width) / 2)
            pict.Top = cel.Top + ((cel.Height - pict.Height) / 2)
        End If
    Next
End Sub

Sub AffImage()
    ' Sélectionner les cellules contenant un lien vers une image et appeler la macro
    ' AffImage les affichera sur le lien ou dans la colonne de gauche ou de droite
    Const hDefaut = 75 ' hauteur des images
    Const imgDefaut = "" ' saisir chemin complet et le nom de l'image par défaut à afficher si erreur
    Dim msg As String, r As Long, h As Long, lmax As Long
    Dim c As Range, numfich As Integer
    Dim fich
    msg = "Oui : Afficher les images à gauche des liens sélectionnés" & vbCrLf
    msg = msg & "Non : Afficher les images sur les liens sélectionnés" & vbCrLf
    msg = msg & "Annuler : Afficher les images à droite des liens sélectionnés"
    r = MsgBox(msg, vbYesNoCancel, "Cellules où mettre les images")
    If r = vbYes Then
        r = -3
    ElseIf r = vbNo Then
        r = 0
    Else
        r = 1
    End If
    h = InputBox("Hauteur des lignes :", "Choix hauteur", hDefaut)
    For Each c In Selection
        'c.ColumnWidth = 10
        fich = c.Value
        ' test fichier
        If fich <> "" Then
            If Left(fich, 7) = "http://" Then
                ' on conserve le lien sur le net
            Else
                numfich = FreeFile()
                On Error GoTo errfich
                Open fich For Input As #numfich
                Close #numfich
                On Error GoTo 0
            End If
        End If
            '
        If fich <> "" Then
            c.RowHeight = h 'fixer la hauteur de ligne
            ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue 'conserver les proportions
                .Height = h - 4 'hauteur de l'image = hauteur des lignes - 4
                .Left = c.Offset(0, r).Left + 2 'à gauche colonne A (sinon tu calcules avec la largeur de colonne)
                .Top = c.Top + 2 'et positionner verticalement
            End With
        End If
    Next c
    centreAllImageonPlage Sheets("affichage").Range("E2:E200")
    Exit Sub
errfich:
    fich = imgDefaut
    Resume Next
End Sub
Sub centreAllImageonPlage(plage)
    Dim pict As Object, cel As Range
    For Each pict In plage.Parent.Shapes
        Set cel = pict.TopLeftCell
        If Not Intersect(cel, plage) Is Nothing Then
            pict.Left = cel.Left + ((cel.Width - pict.Width) / 2)
            pict.Top = cel.Top + ((cel.Height - pict.Height) / 2)
        End If
    Next
End Sub