Erreur 1004 Impossible de lire Insert

Bonjour,

Bonjour à tous,

J’ai passé l’A.M d'hier à adapter la macro ci-dessous à mes besoins dans un classeur que j’utilise régulièrement.
Le but de cette macro est d’incruster des images dans une cellule. Les noms des images sont en colonne « H » et les images sont incrustées en colonne « G ».
Il y a aussi toute une adaptation de l’image aux dimensions de la cellule de destination qui fonctionne très bien.
Quand j’ai éteint l’ordi hier au soir, j’étais content de moi, car ça fonctionnait parfaitement.
J’ai fait des dizaines d’essais sans problème.
Mais ce matin je suis revenu sur mon classeur et là au premier essais :
Erreur d’exécution 1004
Impossible de lire la propriété Insert de la classe Pictures.

Voici ci-dessous ma macro :

Sub insere_image_ratio()

    Dim Design As String    ' N?du fichier photo ? importer.
    Dim Chemin As String    ' Chemin du r?pertoire contenant les photos.
    Dim Fichier As String   ' D?signe l'image chemin+fichier.
    Dim Ficimg As String    ' Image r?pertoire+N? de fichier.
    Dim Cellule_destination As String        ' Cellule d'inscrutation.

    Dim T As Integer
    Dim L As Integer

' Variables Image.
    Dim Larg_finale As Integer      ' Largeur finale de l'image.
    Dim Haut_Finale As Integer      ' Hauteur finale de l'image.
    Dim Larg_Initiale As Long       ' Largeur de l'image.
    Dim Haut_Initiale As Long       ' Hauteur de l'image.
    
' Variables Cellule.
    Dim Larg_Cellule As Long        ' Largeur de la cellule.
    Dim Haut_Cellule As Long        ' Hauteur de la cellule.
    
    Dim L_Ratio As Single           ' Ratio largeur (Image/Cellule).
    Dim H_Ratio As Single           ' Ratio hauteur (Image/Cellule).

    'Dim RatioCell As Single

' ************************************************
' Initialisation.
    Application.ScreenUpdating = False ' Bloque le rafraichissement d'?cran.
    Sheets("Couleur EC").Select
    Sheets("Couleur EC").Activate
    Derlig = Columns("B").Find("*", , , , , xlPrevious).Row ' Calcule de la derni?re ligne active.

' Parcours la liste
    Numero = 1
    For Cptr = 3 To Derlig          ' N? de la premi?re ligne utile.
    Design = Cells(Cptr, "H")       ' H = colonne avec le N? de fichier ? incruster.
    Chemin = "S:\French Digital Tour\__FDT_2019\Recup_photos_FDT2019\Couleur\" ' Chemin ? adapter selon besoin.

' Prise en compte des formats photo autoris?s.
          If Dir(Chemin & Design & ".jpg") <> "" Then Design = Design & ".jpg"
          If Dir(Chemin & Design & ".jpeg") <> "" Then Design = Design & ".jpeg"
          
          On Error GoTo Inconnu
          
          Fichier = Chemin & Design
          'Set Cellule = Cells(Cptr, "G")    '.Select     ' Cellule de destination de l'images ser incrust?e.
          Cells(Cptr, "G").Select
          'Set Image = ActiveSheet.Pictures.Insert(Fichier)

          On Error GoTo 0

' ************************************************
    
        Cellule_destination = Selection.Address     ' Cellule d'incrustation.
        Haut_Cellule = Selection.Height             ' Hauteur de la cellule.
        Larg_Cellule = Selection.Width              ' Largeur de la cellule.
        'Ficimg = Design     'Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
        If Design = "Faux" Then Exit Sub
        ActiveSheet.Pictures.Insert(Design).Select  ' insertion de l'image sur la feuille.
        With Selection.ShapeRange
        
' Mesure de l'image.
            Haut_Initiale = .Height                 ' Hauteur de l'image.
            Larg_Initiale = .Width                  ' Mesure de la largeur de l'image.
           
' Adapte les ratios.
           If Haut_Initiale < Haut_Cellule And Larg_Initiale < Larg_Cellule Then
           
' ** *******************************************
' *   L'image est plus petite que la cellule.  *
' **********************************************

            H_Ratio = Haut_Initiale / Haut_Cellule ' Ratio Hauteur
            L_Ratio = Larg_Initiale / Larg_Cellule ' Ratio Largeur
            
                If L_Ratio < H_Ratio Then 'adapter en hauteur
                    Haut_Finale = Haut_Cellule:  Larg_finale = Larg_Initiale * (Haut_Finale / Haut_Initiale)
                    T = 0: L = (Larg_Cellule - Larg_finale) / 2
                Else 'adapter en largeur
                    Larg_finale = Larg_Cellule: Haut_Finale = Haut_Initiale * (Larg_Cellule / Larg_Initiale)
                    L = 0: T = (Haut_Cellule - Haut_Finale) / 2
                End If
            ElseIf Haut_Initiale > Haut_Cellule And Larg_Initiale > Larg_Cellule Then
            
' **********************************************
' *   L'image est plus grande que la cellule.  *
' **********************************************
'
            H_Ratio = Haut_Cellule / Haut_Initiale ' Ratio Hauteur
            L_Ratio = Larg_Cellule / Larg_Initiale ' Ration largeur

' Adapte la Hauteur.
                If L_Ratio > H_Ratio Then
                    Haut_Finale = Haut_Cellule:  Larg_finale = Larg_Initiale * (Haut_Finale / Haut_Initiale)
                    T = 0: L = (Larg_Cellule - Larg_finale) / 2
                Else

' Adapte la largeur.
                Larg_finale = Larg_Cellule: Haut_Finale = Haut_Initiale * (Larg_finale / Larg_Initiale)
                L = 0: T = (Haut_Cellule - Haut_Finale) / 2
                End If
            ElseIf Haut_Initiale > Haut_Cellule And Larg_Initiale < Larg_Cellule Then
            'adapter en hauteur
               Haut_Finale = Haut_Cellule:  Larg_finale = Larg_Initiale * (Haut_Finale / Haut_Initiale)
                T = 0: L = (Larg_Cellule - Larg_finale) / 2
            ElseIf Haut_Initiale < Haut_Cellule And Larg_Initiale > Larg_Cellule Then
            'adapter en largeur
               Larg_finale = Larg_Cellule: Haut_Finale = Haut_Initiale * (Larg_finale / Larg_Initiale)
                L = 0: T = (Haut_Cellule - Haut_Finale) / 2
            Else
                Stop ' pas prévu ?
           End If
           
            .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
            .Top = Range(Cellule_destination).Top + T ' Fixe la hauteur du coin S.G.
            .Left = Range(Cellule_destination).Left + L ' Fixe le coin S.G.
            .Height = Haut_Finale
            .Width = Larg_finale ' largeur des cellules fusionn?es
       End With
        With Selection
            .Placement = xlMoveAndSize
            .PrintObject = True
        End With
     Next
Inconnu:
    MsgBox "Nom de photo inconnu", vbCritical, "galerie photo"
    Application.ScreenUpdating = True ' R?tabli le rafraichissement d'?cran.

End Sub

Je ne comprends pas pourquoi.
Pouvez-vous m’aider ?
D’avance merci.
Mistral