Image importer via VBA n'est qu'un lien

Bonjour je suis en train de réaliser une macro qui devrait me permet d’insérer une image dans mon document excel.

Met lorsque j'insère l'image est que j'envoie mon fichier excel le destinataire ne peuvent plus avoir accès au image.

Donc pour que l'image reste même lors d'un envoi par mail j'ai lu que je devait utiliser add.picture, j'insere donc ma photo avec shapes.Inser Pour avoir les dimension je la supprime et la réinsére une deuxième fois avec l'autre fonction

Voici mes code Pouvez vous m'aider svp ?

Sub INSERTION_PHOTO_MATERIEL_1()

'DEPROTECTION
    ActiveSheet.Unprotect "xxxx"

'SUPPRIMER LA DERNIERE PHOTO CREE
    If Range("BE6") <> "" Then
    PHOTO1 = Range("BE6").Value
    ActiveSheet.Shape(PHOTO1).Delete
    End If

'SELECTIONER LES CELLULES FUSIONNEES
    Range("BF6:CB16").Select 'emplacement des cellules fusionnées ou la photo sera affiché
        Ad = Selection.Address
        CellH = Selection.Height
        CellW = Selection.Width

'EXTRACTION DE L'IMAGE
    IMPORTATION = Application.GetOpenFilename("Toutes les images (*.jpg;*.bmp;*.tiff;*.tif;*.gif;*.jpeg;*.png;*.jpe;*.jfif),*.jpg;*.bmp;*.tif;*.tiff;*.gif;*.jpeg;*.png;*.jpe;*.jfif", , "Choisissez l'image") ' choix nom du fichier
        If IMPORTATION = "Faux" Then
            MsgBox "Operation annulée" & vbCrLf & "Attention, veuillez renouveler l'action !", vbExclamation
            'SUPRESSION DU NOM DE L'IMAGE PRECEDENTE
                Range("BE6").Select
                Selection.ClearContents
            'SELECTIONER UNE CELLULE
                [BF17].Select
            'PROTECTION
                ActiveSheet.Protect "lesage"
        Exit Sub
        End If

        ActiveSheet.Pictures.Insert(IMPORTATION).Select ' insertion
        With Selection.ShapeRange
            Picture_W = .Width
            Picture_H = .Height
            Picture_L = .Left
            Picture_T = .Top 'Sauvergarde les ratios
            PHOTO2 = .Name
        End With

'ENREGISTRER LE NOM DE L'IMAGE

'ENREGISTREMENT DE L'IMAGE DANS LE DOCUMENT
        Shape.AddPicture (IMPORTATION), False, True, Picture_L, Picture_T, Picture_W, Picture_H

'REDIMENSIONNEMENT DE L'IMAGE AU CELLULE
        With Selection.ShapeRange
            If Picture_H < CellH And Picture_W < CellW Then
            'l'image < cellule
                RatioHz = Picture_H / CellH
                RatioVt = Picture_W / CellW
                If RatioVt < RatioHz Then 'adapter en hauteur
                    HT = CellH:  Lg = Picture_W * (HT / Picture_H)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                    Lg = CellW: HT = Picture_H * (CellW / Picture_W)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf Picture_H > CellH And Picture_W > CellW Then
            'l'image > cellule
                RatioHz = CellH / Picture_H
                RatioVt = CellW / Picture_W
                If RatioVt > RatioHz Then 'adapter en hauteur
                    HT = CellH:  Lg = Picture_W * (HT / Picture_H)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                    Lg = CellW: HT = Picture_H * (Lg / Picture_W)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf Picture_H > CellH And Picture_W < CellW Then
            'adapter en hauteur
                HT = CellH:  Lg = Picture_W * (HT / Picture_H)
                T = 0: L = (CellW - Lg) / 2
            ElseIf Picture_H < CellH And Picture_W > CellW Then
            'adapter en largeur
                Lg = CellW: HT = Picture_H * (Lg / Picture_W)
                L = 0: T = (CellH - HT) / 2
            Else
                Stop ' pas prévu ?
            End If

            .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
            .Top = Range(Ad).Top + T ' haut de la cellule
            .Left = Range(Ad).Left + L ' gauche de la cellule
            .Height = HT
            .Width = Lg ' largeur des cellules fusionnées
        End With
        With Selection
            .Placement = xlMoveAndSize
            .PrintObject = True
        End With

'ENREGISTRER LE NOM DE L'IMAGE DANS LA CELLULE A GAUCHE
    PHOTO3 = Selection.ShapeRange.Name
    Range("BE6").Value = PHOTO3

'SUPRESSION DE LA PHOTO 2
    ActiveSheet.Shapes(PHOTO2).Delete

'SELECTIONER UNE CELLULE
    [BF17].Select

'PROTECTION
    'ActiveSheet.Protect "xxxx"

End Sub

Résolu

Sub INSERTION_PHOTO_MATERIEL_1()

'DEPROTECTION
    ActiveSheet.Unprotect "lesage"

'SUPPRIMER LA DERNIERE PHOTO CREE
    If Range("BE6") <> "" Then
    PHOTO = Range("BE6").Value

'MESSAGE D'AVERTISSEMENT
        Dim Msg_Sup, Style, Title, response
            Msg_Sup = "Etes vous sûr de vouloir insérer une nouvelle image ? " & vbCrLf & "Aucun retour en arrière ne sera possible" & vbCrLf & " L'image sera detruite du document Excel"
            Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Définit les boutons.
            Title = "Importation d'une nouvelle image" ' Définit le titre.
            response = MsgBox(Msg_Sup, Style, Title)  ' Affiche le message.

'SI NON AU MESSAGE
        If response = vbNo Then ' L'utilisateur a choisi Non.
            MyString = "Non" ' Effectue une action.
            [BF17].Select
            ActiveSheet.Protect "lesage"
            Exit Sub
        ElseIf response = vbYes Then
            ActiveSheet.Shapes(PHOTO).Delete
        End If
    Else
    End If

'SELECTIONER LES CELLULES FUSIONNEES
        Range("BF6:CB16").Select 'emplacement des cellules fusionnées ou la photo sera affiché
                With Selection
                    Picture_W = .Width
                    Picture_H = .Height
                    Picture_L = .Left
                    Picture_T = .Top
                End With

    'EXTRACTION DE L'IMAGE
        IMPORTATION = Application.GetOpenFilename("Toutes les images (*.jpg;*.bmp;*.tiff;*.tif;*.gif;*.jpeg;*.png;*.jpe;*.jfif),*.jpg;*.bmp;*.tif;*.tiff;*.gif;*.jpeg;*.png;*.jpe;*.jfif", , "Choisissez l'image") ' choix nom du fichier
            If IMPORTATION = "Faux" Then
                MsgBox "Operation annulée" & vbCrLf & "Attention, veuillez renouveler l'action !", vbExclamation
                'SUPRESSION DU NOM DE L'IMAGE PRECEDENTE
                    Range("BE6").Select
                    Selection.ClearContents
                'SELECTIONER UNE CELLULE
                    [BF17].Select
                'PROTECTION
                    ActiveSheet.Protect "lesage"
            Exit Sub
            End If

    'ENREGISTREMENT DE L'IMAGE DANS LE DOCUMENT
            Set pict = LoadPicture(IMPORTATION)
            Set IMG = ActiveSheet.Shapes.AddPicture(IMPORTATION, False, True, Picture_L, Picture_T, Picture_W, Picture_H) 'on l'insere une deuxieme fois pour l'enregistrer dans le document
            IMG.Select
            'PHOTO2 = IMG.Name

    'ENREGISTRER LE NOM DE L'IMAGE DANS LA CELLULE A GAUCHE
            PHOTO2 = Selection.ShapeRange.Name
            Range("BE6").Value = PHOTO2

    'SELECTIONER UNE CELLULE
            [BF17].Select

    'PROTECTION
        ActiveSheet.Protect "lesage"
End Sub