Séquence avec plantage aléatoire (ou pas)

Bonjour
j'ai la séquence suivante :

Code:

---

1 2 3 4 5 6 7 8 9 10

For Each shap In catalogue.Shapes If shap.TopLeftCell.Address = "$D$" & i1 Then catalogue.Shapes(shap.Name).Height = haut ' dimensionne la photo catalogue.Shapes(shap.Name).Copy pdfS.Range("B" & Delta1 + 2).Select pdfS.Paste Exit For Else End If Next

---

Si je lance plusieurs fois de suite la macro qui contient cette séquence, j'ai un résultat aléatoire :

Soit ça marche bien, soit ça plante à des endroit différents avec le message

Citation:

---

Erreur d'exécution 1004
La méthode "Paste" de l'objet _Worksheet a échoué

---

J'ai fait de multiples tests sans explications (à mon niveau)

en fait je voulais redimensionner la photo :

Code:

---

catalogue.Shapes(shap.Name).Height = haut

---

après la copie, mais je n'y parviens pas. Je ne pense pas que le plantage vienne de là de toutes façons

Avez-vous une idée de ce qui peux donner ce plantage aléatoire (et aussi le bon fonctionnement aléatoire !) dans cette séquence

Nouveaux tests :
1er clic : plantage ligne 53
2eme clic : plantage line 149
3eme clic : ok

Il y a 168 lignes à traiter

Une autre façon de faire peut être ?
merci

Bonjour,

Essayer ceci:

Code:

---

1 2 3 4 5 6 7 8 9 10

For Each shap In catalogue.Shapes If shap.TopLeftCell.Address = "$D$" & i1 Then shap.Height = haut ' dimensionne la photo shap.Copy pdfS.Select pdfS.Range("B" & Delta1 + 2).Select pdfS.Paste Exit For End If Next

---

Cordialement.

Bonjour

j'ai le même résultat ou ça marche ou pb de plantage aléatoire, cette fois sur

Code:

---

shap.Copy

---

avec le code proposé

Bonjour,

Eventuellement ceci:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

Sub LaSub() '... For Each shap In catalogue.Shapes If shap.TopLeftCell.Address = "$D$" & i1 Then On Error GoTo Panne Copier: shap.Copy On Error GoTo 0 Application.Goto pdfS.Range("B" & Delta1 + 2) ActiveSheet.Paste ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height = haut '--- modifie hauteur de ce qui vient d'être copié Exit For End If Next '... Exit Sub Panne: If MsgBox("Réessayer?", vbYesNo, "Oui/Non?") = vbYes Then Resume Copier End If End Sub

---

Cordialement.

Je viens d'essayer

à un moment donné j'ai bien le message réessayer

je réponds oui puis même plantage

Je ne saisi pas le côté aléatoire du pb

Oui, bizarre. Essayer récupérer le n° de l'erreur pour en savoir plus:

Code:

---

1 2 3

If MsgBox("Erreur " & Err.Number & vbLf & _ Err.Description & vbLf & _ "Réessayer?", vbYesNo, "Oui/Non?") = vbYes Then

---

Cordialement.

En faisant cela

j'ai d'abord erreur 0
Voulez-vous ressayer ?

Yes

Erreur d'exécution 20

Essayer d'ajouter un

Code:

---

1 2	Application.CutCopyMode = False Exit For

---

juste avant le Exit For

Cordialement.

Bonjour,
Je ne suis pas un grand spécialiste des images mais j'ai dû déjà en manipuler de temps en temps
A mon avis, vos erreurs n'étaient pas aléatoires mais tout simplement que lorsque la feuille source ou une autre était active, il y avait erreur mais pas lorsque la feuille cible l'était.
Ce qu'Eric a tenté de détourner par un Goto

Les Select ne sont pas une bonne idée.

Le problème est toujours pareil pour les copies, que ce soit des feuilles, des cellules, des images, nous avons une source et une cible
Si j'ai bien compris, vous souhaitez copier une image si elle touche la cellule D2 de la feuille catalogue et vous voulez la copier sur la feuille PdfS au dessus d'une cellule dont l'adresse m'est inconnue puisque il manque des bouts de code

Règle numéro 1 en programmation : Découper le problème pour chaque étape à réaliser et créer des fonctions qui font le job (ici la copie de l'image d'une source vers une cellule cible)
La lecture de votre programme mais surtout la maintenance n'en sera que simplifiée

J'ai écrit en vitesse, une fonction qui fait cela mais incomplète et les tests effectués très basiques

La fonction incomplète

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Function CopyShape(oShape As Shape, oRange As Range) oShape.Copy ' Copie d'image With oRange.Worksheet .Paste ' Colle l'image sur la feuille de la cellule cible With .Shapes(.Shapes.Count) ' Positionne l'image sur la feuille par rapport à la cellule cible .Left = oRange.Left ' .Top = oRange.Top ' etc. End With End With End Function

---

et votre procédure allégée qui copie l'image se trouvant en D2 de la feuille catalogue et la colle en G4 de la feuille pdfS

Code:

---

1 2 3 4 5 6 7 8 9 10

Sub t() Dim shap As Shape Dim i1 as long i1 = 2 For Each shap In Catalogue.Shapes If shap.TopLeftCell.Address = "$D$" & i1 Then CopyShape shap, pdfS.Range("G4") End If Next End Sub

---

Et si vous avez plusieurs images à copier, créer également une fonction générique qui renverra True ou False si la condition est remplie et prévoyez éventuellement une table de conversion (Mapping) qui indique le nom des cellules où se trouve les images et l'endroit où elles devront être copiées.
Pensez toujours maintenance.

Une fonction bien testée, ne bouge plus et on ne la retravaille que dans le seul but d'être améliorée.
Les tables de mapping permettent de changer les paramètres nécessaire à la bonne marche des programmes sans plus avoir à toucher au code VBA

Bonjour,

n'arrivant pas à résoudre le problème j'ai fait de multiples essais et un de mes essais a été fructueux.

Au lieu de tout faire dans la même boucle, j'ai fait une 1ere boucle pour redimensionner les images et une seconde identique pour les copier

Et là curieusement je n'ai plus le problème (j'ai fait de nombreux tests avec cette solution, tout est ok)

J'ai repris la première version de mon code pour en avoir le cœur net, et le pb est revenu

Je n'ai aucune idée du pourquoi des choses mais ça marche

Merci de votre participation