Excel VBA - Erreur d'exécution '1004' - Pour copier et coller des images

Bonjour/bonsoir,

J'espère que vous allez bien.

J'ai un problème avec le programme que j'essaie de faire en ce moment.

Pour le contexte, j'aimerais "automatiser" de la détection et du copier-coller d'informations, entre une feuille excel dans laquelle j'exporte des données d'un logiciel, et des feuilles types, afin de préparer les informations pour les implémenter dans des rapports. Cela permettrait également d'éviter la double saisie, logiciel + rapport.

Pour la phase "texte", c'est bon j'ai fais un code qui fonctionne et me satisfait pour le moment. Il est surement très grandement optimisable mais mon niveau n'est pas très poussé, on fait comme on peux.

C'est pour la phase "image" que j'ai un problème, la détection et l'action de copier-coller là où il faut, fonctionnent bien.

Mais j'ai un problème d'erreur 1004 : La méthode Copy de la classe Picture a échoué. Et parfois c'est la méthode Paste.

Je ne pense que que ce soit aléatoire mais l'erreur apparait au(x) même(s) endroit(s) puis à d'autres.

Du coup je fais débogage et le continue l'exécution, ça finit par aller jusqu'au bout, mais il faut que je trouve un moyen de supprimer ces erreurs.

Le fichier (j'ai supprimé tout le code et les feuilles non nécessaires) :

J'imagine que pour des initiés, c'est pitoyable mais j'ai creusé, sans succès donc je fais appel à l'aide.

Merci d'avance pour le temps passé à regarder ce fichier.

Bonne soirée

Bonjour,

Je n'ai pas d'erreur dans le fichier joint.

A+

Bonsoir,

Mes excuses, en censurant des données, j'ai oublié de renommer certains termes.

L'une des feuilles n'était plus détectée donc plus rien ne fonctionnait.

J'ai corrigé cette erreur.

L'erreur 1004 revient.

Nouveau fichier :

Bonne soirée

Bonsoir,

Pas d'erreur non plus avec ce classeur.

A+

bonsoir,

tout ces "activate" et "select", ca c'est inutile et avec with ... end with tout est plus simple.

Sub SélectionShapeChamp()

     With Worksheets("Données export PT")     'cette feuille
          For Each Forme In .Shapes     'tous les shapes
               If Not Intersect(Forme.TopLeftCell, .Range(.Cells(Ligne1recherche, Colonne1recherche), .Cells(Ligne2recherche, Colonne2recherche))) Is Nothing Then     'ils se trouvent dans la bonne plage
                    'MsgBox Forme.TopLeftCell.Address
                    Forme.Copy     'copie
                    With Worksheets("PT")     'cette feuille de destination
                         .Paste     'coller
                         Set c = .Cells(Lignecollage, Colonnecollage)     'cellule de destination
                         With .Shapes(.Shapes.Count)     'shape le plus recent
                              .Top = c.Top
                              .Left = c.Left
                         End With
                    End With
               End If
          Next Forme
     End With
End Sub

Bonsoir,

Merci à vous deux pour avoir regardé.

Galopin01, je ne comprends pas pourquoi aucune erreur n'apparait pour toi, j'ai les mêmes à chaque fois.

BsAlv, ta correction fonctionne bien pour moi. Plus d'erreurs.

Si je comprends bien la modification, tu copies la forme et non la sélection, et tu colles puis replaces la forme plutôt que coller directement dans la cellule.

Et ça fonctionne au poil.

Pour les with ... end, je ne les ai jamais utilisé, mais il faudrait en effet, c'est plus propre et efficace.

Mon autre sub() vous ferrait vous arracher les cheveux... Il faut que je retouche.

En tout cas, merci à vous deux.

Je clôturerai dans quelques jours, au cas où.

Bonne soirée

re,

exactement, je copie le shape et le colle dans l'autre feuille et puis je le replace.

Rare, mais cela peut arriver que excel est trop lent et le shape n'est pas encore bien registré dans l'autre feuille. Si cela se produit, il faut ajouter quelque "doevents" pour ralentir excel. Ou, vous pouvez le faire directement par precaution.

 With Worksheets("PT")     'cette feuille de destination
                         .Paste     'coller
                         DoEvents
                        Set c = .Cells(Lignecollage, Colonnecollage)     'cellule de destination
                        DoEvents
                        With .Shapes(.Shapes.Count)     'shape le plus recent
                              .Top = c.Top
                              .Left = c.Left
                         End With
                    End With