[VBA] Problème pour copier/coller une image d'un classeur à un autre
Bonjour,
Je dois récupérer des images de plusieurs fichiers excel pour les mettre sur un autre classeur où elles seront centralisées (2 images par fichier). Je réussi à copier/coller la 1ere image, mais lorsque je copie la 2eme je tombe sur cette erreur : "La méthode 'Copy' de l'objet 'Shape' a échoué", quand je vais dans 'debogage' et que je relance l'instruction qui a échouée ça marche, puis ça refait la même chose pour la 2eme image du fichier suivant
Je ne vois pas du tout d'où peut venir ce problème, si vous pouvez m'aider. Voici le code de la fonction qui copie/colle, elle est appelée pour chaque fichier (sheet ws), l'erreur vient au 2eme 'shp.copy'
Sub Photo()
For Each shp In ws.Shapes 'parcours des objets du fichier où se trouve les image à récuperer
If shp.Type = 13 Then 'si l'objet est une image
If Not Intersect(shp.TopLeftCell, ws.Range("A62")) Is Nothing Then 'si l'image se trouve à l'emplacement de la 1ere image
shp.Width = 246 'redimensionnement
shp.Height = 300
shp.Copy 'copie de l'image (marche)
new_C6.Sheets("Photos").Range("A" & idPh).PasteSpecial 'colle dans le classeur où les image seront centralisées
Application.CutCopyMode = False 'Vide presse papier
new_C6.Sheets("Photos").Range("A" & idPh + 1).Value = ws.Range("A26").Value & "_1" 'écriture de la description en dessous de la photo
End If
If Not Intersect(shp.TopLeftCell, ws.Range("M62")) Is Nothing Then 'si l'image se trouve à l'emplacement de la 2eme image
shp.Width = 246 'redimensionnement
shp.Height = 300
shp.Copy 'copie de l'image (ne marche pas)
new_C6.Sheets("Photos").Range("B" & idPh).PasteSpecial 'colle dans le classeur où les image seront centralisées
Application.CutCopyMode = False 'Vide presse papier
new_C6.Sheets("Photos").Range("B" & idPh + 1).Value = ws.Range("A26").Value & "_2" 'écriture de la description en dessous de la photo
End If
ws.Activate
End If
Next
End SubLe message d'erreur était précisément "erreur d'execution '-2147221040 La méthode 'Copy' de l'objet 'Shape' a échoué"
J'ai mis un petit delai de 200 ms avant les 'copy' et ça marche, tout s'enchaine bien, et ça ne ralenti pas trop ma macro. Le presse papier devait avoir du mal à suivre le rythme avec plusieurs copier/coller d'image à la suite
WaitFor (0.2)
shp.Copy
new_C6.Sheets("Photos").Range("A" & idPh).PasteSpecial
'...
'avec
Sub WaitFor(NumOfSeconds As Single)
Dim SngSec As Single
SngSec = Timer + NumOfSeconds
Do While Timer < SngSec
DoEvents
Loop
End Sub