XL 2019 PasteSpecial

  • Initiateur de la discussion Initiateur de la discussion GUERET
  • Date de début Date de début
G

GUERET

XLDnaute Occasionnel
Bonjour, j'ai un petit souci avec mon fichier car de temps en temps j'obtiens ce message : Erreur d'execution La méthodes PasteSpecial de la range a échouée

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H3")) Is Nothing Then
ListerCourses
End If
End Sub


Private Sub Worksheet_Activate()
Dim c As Range, sh As Shape


Application.ScreenUpdating = False
For Each sh In Feuil2.Shapes
sh.Delete
Next
For Each sh In Feuil27.Shapes
If sh.TopLeftCell.Column = 4 Then
If Not IsError(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Feuil2.Range("B5:B35"), 0)) Then
sh.Copy
Feuil2.Range("A3").Offset(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Feuil2.Range("B5:B35"), 0), 0).PasteSpecial
End If
End If
Next
For Each sh In Feuil2.Shapes
sh.Height = sh.TopLeftCell.Height
Next
Application.ScreenUpdating = True
End Sub

Ca fout la grouille dans mes photos en feuille "pilotes", parfois dans mes feuilles de courses. Il faut alors que j'aille sur une autre feuille pour que tout rentre dans l'ordre. Qui plus est, dans ma feuille 'Pilotes", la photo du dernier pilote SAVADORI Lorenzo n'apparait plus. Où se situe donc le problème ???
D'avance, merci

www.transfernow.net

Transfer not found - TransferNow

Click to download the files for this transfer with TransferNow
www.transfernow.net www.transfernow.net
 
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @GUERET
GUERET à dit:
la photo du dernier pilote SAVADORI Lorenzo n'apparait plus. Où se situe donc le problème ???
Cliquez pour agrandir...
Il y a 2 occurrences de SAVADORI Lorenzo sur tes feuilles "Photos" et "Pilotes" respectivement en D28 & D34 sur Photos et B27 & B35 sur Pilotes. Les deux photos sont en fait superposées en A27.
Pour le bug je n'arrive pas à le reproduire. Je cherche un peu plus et je reviens vers toi
Amicalement
Alain
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Re,
la photo en D28 est en fait celle de michele pirro
1651343032310.png

qui n'apparaît pas dans tes deux listes (Photos & Pilotes)
à plus
Alain
 
Vote positif 0 Vote négatif
G

GUERET

XLDnaute Occasionnel
AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @GUERET

Il y a 2 occurrences de SAVADORI Lorenzo sur tes feuilles "Photos" et "Pilotes" respectivement en D28 & D34 sur Photos et B27 & B35 sur Pilotes. Les deux photos sont en fait superposées en A27.
Pour le bug je n'arrive pas à le reproduire. Je cherche un peu plus et je reviens vers toi
Amicalement
Alain
Cliquez pour agrandir...
Merci pour ton attention et bon WE.
 
Vote positif 0 Vote négatif
G

GUERET

XLDnaute Occasionnel
AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @GUERET

Il y a 2 occurrences de SAVADORI Lorenzo sur tes feuilles "Photos" et "Pilotes" respectivement en D28 & D34 sur Photos et B27 & B35 sur Pilotes. Les deux photos sont en fait superposées en A27.
Pour le bug je n'arrive pas à le reproduire. Je cherche un peu plus et je reviens vers toi
Amicalement
Alain
Cliquez pour agrandir...
Bonsoir, je reviens encore avec mon pb de PasteSpecial qui survient lorsque je change de feuille et en plus, cela bloque mes menus déroulants dans la feuille "Pilotes". Je ne suis pas fortiche en VBA.
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @GUERET
Les 2 problèmes sont différents
GUERET à dit:
cela bloque mes menus déroulants dans la feuille "Pilotes"
Cliquez pour agrandir...
Cela provient du fait que tu supprimes toutes les shapes de la feuille "Pilotes" (Excel crée des shapes DropDown pour les listes déroulantes des validations).
Contentons nous de ne supprimer que les images :
VB: 
    ...
    For Each sh In Me.Shapes
        If sh.Type = msoPicture Then sh.Delete
    Next
    ...
GUERET à dit:
je reviens encore avec mon pb de PasteSpecial qui survient lorsque je change de feuille
Cliquez pour agrandir...
Là, je ne connais pas la cause, cela semble aléatoire.
J'ai remarqué qu'en mode Débug, si on relance la macro à la ligne qui effectue la copie, l'erreur ne se reproduit pas : d'où une tentative de contournement par gestion de l'erreur :
Code: 
...
                         Rpt = 0
Répéter:                 sh.Copy
                         Rpt = Rpt + 1
                         If Rpt > 2 Then MsgBox "Echec sur le collage : " & sh.Name: Exit Sub
                         If Rpt = 2 Then MsgBox "2ème tentative pour " & sh.Name
                         On Error GoTo Répéter
                         Me.Range("A3").Offset(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0), 0).PasteSpecial
                         On Error GoTo 0

...
Le code complet :
VB: 
Private Sub Worksheet_Activate()
Dim c As Range, sh As Shape, Nom As String, Rpt As Byte

     Application.ScreenUpdating = False
     For Each sh In Me.Shapes
          If sh.Type = msoPicture Then sh.Delete
     Next
     For Each sh In Feuil27.Shapes
          If sh.Type = msoPicture Then
               If sh.TopLeftCell.Column = 4 Then
                    If Not IsError(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0)) Then
                         Nom = sh.Name
                         Rpt = 0
Répéter:                 sh.Copy
                         Rpt = Rpt + 1
                         If Rpt > 2 Then MsgBox "Echec sur le collage : " & sh.Name: Exit Sub
                         If Rpt = 2 Then MsgBox "2ème tentative pour " & sh.Name
                         On Error GoTo Répéter
                         Me.Range("A3").Offset(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0), 0).PasteSpecial
                         On Error GoTo 0
                         Selection.Height = Selection.TopLeftCell.Height
                         Selection.Name = Nom
                    End If
               End If
          End If
     Next
     Application.ScreenUpdating = True
End Sub

Remarque : J'ai nommé les photos de la feuille Photos à l'aide d'une macro dans le module4 .
Code: 
Sub NommerPhotos()

     For Each sh In Feuil27.Shapes
          With sh
          Select Case True
               Case .TopLeftCell.Column = 4 And .TopLeftCell.Row < 35
                    .Name = "Pilote|" & Feuil27.Cells(.TopLeftCell.Row, 2)
               Case .TopLeftCell.Column = 8 And .TopLeftCell.Row < 16
                    .Name = "Moto|" & Feuil27.Cells(.TopLeftCell.Row, 6)
               Case .TopLeftCell.Column = 11 And .TopLeftCell.Row < 16
                    .Name = "Logo|" & Feuil27.Cells(.TopLeftCell.Row, 10)
               Case Else
          End Select
          End With
     Next sh
    
End Sub

et une autre pour la dimension des photos
Code: 
Sub PositionTaille()

     Largeur = Feuil27.[L1].Left - Feuil27.[K1].Left - 4
     Hauteur = Feuil27.[D5].Top - Feuil27.[D4].Top - 4
     For Each sh In Feuil27.Shapes
          With sh
               If .TopLeftCell.Column = 4 Or .TopLeftCell.Column = 8 Or .TopLeftCell.Column = 11 Then
                    .Top = .TopLeftCell.Top + 2
                    .Left = .TopLeftCell.Left + 2
                    .Width = Largeur
                    If .Height > Hauteur Then .Height = Hauteur
               End If
          End With
     Next sh

End Sub

Voilà j'espère que cela réglera ton problème
Amicalement
Alain
 
Vote positif 0 Vote négatif
G

GUERET

XLDnaute Occasionnel
AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @GUERET
Les 2 problèmes sont différents

Cela provient du fait que tu supprimes toutes les shapes de la feuille "Pilotes" (Excel crée des shapes DropDown pour les listes déroulantes des validations).
Contentons nous de ne supprimer que les images :
VB: 
    ...
    For Each sh In Me.Shapes
        If sh.Type = msoPicture Then sh.Delete
    Next
    ...

Là, je ne connais pas la cause, cela semble aléatoire.
J'ai remarqué qu'en mode Débug, si on relance la macro à la ligne qui effectue la copie, l'erreur ne se reproduit pas : d'où une tentative de contournement par gestion de l'erreur :
Code: 
...
                         Rpt = 0
Répéter:                 sh.Copy
                         Rpt = Rpt + 1
                         If Rpt > 2 Then MsgBox "Echec sur le collage : " & sh.Name: Exit Sub
                         If Rpt = 2 Then MsgBox "2ème tentative pour " & sh.Name
                         On Error GoTo Répéter
                         Me.Range("A3").Offset(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0), 0).PasteSpecial
                         On Error GoTo 0

...
Le code complet :
VB: 
Private Sub Worksheet_Activate()
Dim c As Range, sh As Shape, Nom As String, Rpt As Byte

     Application.ScreenUpdating = False
     For Each sh In Me.Shapes
          If sh.Type = msoPicture Then sh.Delete
     Next
     For Each sh In Feuil27.Shapes
          If sh.Type = msoPicture Then
               If sh.TopLeftCell.Column = 4 Then
                    If Not IsError(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0)) Then
                         Nom = sh.Name
                         Rpt = 0
Répéter:                 sh.Copy
                         Rpt = Rpt + 1
                         If Rpt > 2 Then MsgBox "Echec sur le collage : " & sh.Name: Exit Sub
                         If Rpt = 2 Then MsgBox "2ème tentative pour " & sh.Name
                         On Error GoTo Répéter
                         Me.Range("A3").Offset(Application.Match(Feuil27.Range("B" & sh.TopLeftCell.Row), Me.Range("B5:B35"), 0), 0).PasteSpecial
                         On Error GoTo 0
                         Selection.Height = Selection.TopLeftCell.Height
                         Selection.Name = Nom
                    End If
               End If
          End If
     Next
     Application.ScreenUpdating = True
End Sub

Remarque : J'ai nommé les photos de la feuille Photos à l'aide d'une macro dans le module4 .
Code: 
Sub NommerPhotos()

     For Each sh In Feuil27.Shapes
          With sh
          Select Case True
               Case .TopLeftCell.Column = 4 And .TopLeftCell.Row < 35
                    .Name = "Pilote|" & Feuil27.Cells(.TopLeftCell.Row, 2)
               Case .TopLeftCell.Column = 8 And .TopLeftCell.Row < 16
                    .Name = "Moto|" & Feuil27.Cells(.TopLeftCell.Row, 6)
               Case .TopLeftCell.Column = 11 And .TopLeftCell.Row < 16
                    .Name = "Logo|" & Feuil27.Cells(.TopLeftCell.Row, 10)
               Case Else
          End Select
          End With
     Next sh
   
End Sub

et une autre pour la dimension des photos
Code: 
Sub PositionTaille()

     Largeur = Feuil27.[L1].Left - Feuil27.[K1].Left - 4
     Hauteur = Feuil27.[D5].Top - Feuil27.[D4].Top - 4
     For Each sh In Feuil27.Shapes
          With sh
               If .TopLeftCell.Column = 4 Or .TopLeftCell.Column = 8 Or .TopLeftCell.Column = 11 Then
                    .Top = .TopLeftCell.Top + 2
                    .Left = .TopLeftCell.Left + 2
                    .Width = Largeur
                    If .Height > Hauteur Then .Height = Hauteur
               End If
          End With
     Next sh

End Sub

Voilà j'espère que cela réglera ton problème
Amicalement
Alain
Cliquez pour agrandir...
Sitôt dit sitôt fait et encore merci pour cette aide
Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
330
micie1509
micie1509
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
337
Phil69970
Phil69970
cathodique
  • Question Question
XL 2010 Comment lire array dans item dictionnaire
2 3
Réponses
33
Affichages
2 K
cathodique
cathodique
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
300
sylvanu
sylvanu
Nicolas JACQUIN
  • Question Question
XL 2021 Optimisation code pour affichage ligne et colonne
Réponses
14
Affichages
692
patricktoulon
patricktoulon
A
  • Question Question
XL 2016 Macro et rajout d'un chiffre au nom d'un Shape
Réponses
9
Affichages
611
alain.raphael
A
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
254
MBEPID
M
J
  • Question Question
Microsoft 365 Ajouter une colonne
Réponses
0
Affichages
426
Juliopapadopulos
J
A
  • Question Question
XL 2019 Mélange aléatoire colonne A sur colonne G ne fonctionne pas
Réponses
3
Affichages
220
arvin
A
D
  • Question Question
XL 2021 Déplacer un saut de page (manuel ou pas)
Réponses
4
Affichages
208
vgendron
vgendron
P
  • Question Question
XL 2016 Compteur avec incrémentation de la ligne suivante
Réponses
11
Affichages
249
Pascal THIDET
P
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
403
job75
job75
E
  • Question Question
Microsoft 365 Total général TCD à gauche : Solution VBA ?
Réponses
2
Affichages
409
merinos-BernardEtang
merinos-BernardEtang
N
  • Résolu(e)
Microsoft 365 Simplifier un code pour activer ou désactiver des CheckBox
6 7 8
Réponses
115
Affichages
3 K
ChTi160
ChTi160
Nicolas JACQUIN
  • Question Question
XL 2021 Création et adaptation barre de progression
2 3
Réponses
44
Affichages
1 K
Tartine
T
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
Phil69970
R
  • Résolu(e)
Microsoft 365 Extraction contenu mail outlook vers excel
2
Réponses
18
Affichages
1 K
raf26
R
A
  • Question Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
188
Anthony_51
A
Amigo
  • Question Question
XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier
2 3
Réponses
33
Affichages
1 K
Amigo
Amigo
D
  • Question Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
945
AtTheOne
AtTheOne

Membres actuellement en ligne

26 membres et 365 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 268
Messages
2 117 915
Membres
113 379
dernier inscrit
salom-22