Macro ne fonctionne qu'en pas à pas

Bonjour à tous,

Pour commencer, merci à tous. Je ne suis pas du tout un expert VBA mais grâce aux nombreuses réponses trouvées sur ce sites (et d'autres), j'ai pu m'aventurer sur ces chemins.

J'ai bricolé des macros qui me permettent d'ajouter des logos sur plusieurs documents issus de ma trame. La macro qui me pose problème est celle pour mettre en en-tête ce fameux logo. La macro fonctionne parfaitement en pas à pas mais pas autrement. Enfin, elle fonctionne mais affiche un carré blanc à la place du logo.

Je vous mets ci-dessous le code qui doit être défaillant. A l'origine, il était dans un module. Je l'ai mis sur la feuil27 sans plus de succès après avoir lu que ça pouvait peut-être réglé mon problème.

Pourriez-vous m'aider, s'il-vous-plaît ? Je suis dessus depuis un sacré bout de temps et je n'en vient pas à bout !

Sub InsertionImage10()

 

    Dim Emplacement As Range

    Dim img As Object

    Dim ShapeObj As Shape

   

    Feuil27.Visible = 1

    Feuil27.Activate

    'Boucle pour supprimer l'ancienne image

    For Each ShapeObj In ActiveSheet.Shapes

        If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete

    Next ShapeObj

 

    

    'Nouvelle image

    Feuil4.Activate

    Feuil4.Select

    Feuil4.Shapes.Range(Array("Cible")).Select

    Selection.Copy

    Feuil27.Select

    Range("J1:J2").Select

    ActiveSheet.Paste

        

    Set Emplacement = Range("J1:J2")

    Set img = Feuil27.DrawingObjects(ActiveSheet.Shapes.Count)

 

        With img.ShapeRange

            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)

            .Name = "Cible"

            .LockAspectRatio = msoTrue

            .Left = Emplacement.Left

            .Top = Emplacement.Top

            .Height = Emplacement.Height      'ajuste la hauteur de l'image aux cellules sélectionnée --> ici, 3 cellules

            '.Width = Emplacement.Width        'ajuste la largeur de l'image aux cellules sélectionnée --> ici, 1 cellules

        End With

 

   Dim logotemp As String, mylogo As Object

 

    logotemp = ThisWorkbook.Path & "\logotemp.jpg"

    With Feuil27 ' adapte ton sheets

        Set mylogo = .Shapes("Cible")    ' adapte le nom de ta shape ici

        mylogo.Copy

        With .ChartObjects.Add(0, 0, mylogo.Width, mylogo.Height).Chart

            .Paste    'colle l'image dans un graphique temporaire

            .Export logotemp, "JPG"    'enregistre  l'image temporaire (logotemp.jpg)  dans le même répertoire que ce classeur.

            .Parent.Delete    'on supprime le chart temporaire

        End With

        Feuil16.PageSetup.LeftHeaderPicture.Filename = logotemp

        Feuil16.PageSetup.LeftHeader = "&G"

        Feuil19.PageSetup.LeftHeaderPicture.Filename = logotemp

        Feuil19.PageSetup.LeftHeader = "&G"

        Feuil20.PageSetup.LeftHeaderPicture.Filename = logotemp

        Feuil20.PageSetup.LeftHeader = "&G"

        Feuil8.PageSetup.LeftHeaderPicture.Filename = logotemp

        Feuil8.PageSetup.LeftHeader = "&G"

       

    End With

   ' Kill logotemp    ' on suprime le fichier logotemp.jpg

    Feuil27.Shapes("Cible").Delete

    Feuil27.Visible = 0

      

End Sub