Discussion :

[retraite83]

Bonjour
j'ai la séquence suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 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

[EricDgn]

Bonjour,

Essayer ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[retraite83]

Bonjour

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

shap.Copy

avec le code proposé

[EricDgn]

Bonjour,

Eventuellement ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[retraite83]

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

[EricDgn]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Cordialement.

[retraite83]

En faisant cela

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

Yes

Erreur d'exécution 20

[EricDgn]

Essayer d'ajouter un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Application.CutCopyMode = False
Exit For

juste avant le Exit For

Cordialement.

[Philippe Tulliez]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[retraite83]

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