XL 2016 Macro erreur exécution

[crackerwood]

Bonjour à tous. J'ai un erreur problème pour une macro qui fonctionner avant.

Je vous explique : j'ai créer un système de suivi de stagiaire pour nos formations et à la fin du stage je peux extraire tous les onglets en ppt pour la commission de fin.
Il y a quelques mois cela fonctionnais parfaitement mais depuis peu j'ai une erreur exécution -2147188160 (80048240) : shapes.pastespecial : invalid request. et je n'arrive pas à le résoudre.
J'ai essayé avec différente commande du type attendre (marche pas), vider le presse papier (marche pas à cause de la dll user32). et de changer le datatype.
Je suis sur le pc professionnel et je n'ai pas un accès à 100% (dll ?). J'ai également essayé le code avec F8 (pas à pas détaillé) et cela fonctionne parfaitement.

Ne pouvant pas vous fournir le tableau (car trop de données confidentiel ... désolé) je vous donne le code de la partie export en PPT. J'espère avoir été assez clair et que quelqu'un pourras m'apporter son aide.

' Prépare le PPT de présentation
Set pptapp = CreateObject("PowerPoint.Application")
Set ppt = pptapp.Presentations.Add

i = Sheets.Count
For i = Sheets.Count To 7 Step -1
    Sheets(i).Select
    
With pptapp
    Set newSlide = ppt.Slides.Add(1, 12) ' ppLayoutBlank = 12
    ActiveSheet.Range("A1:Q37").Copy
    newSlide.Shapes.PasteSpecial DataType:=2 'LIGNE QUI CREER LE BUG
Set Graphic = GetObject(, "Powerpoint.Application")
    With Graphic.ActiveWindow.Selection.ShapeRange
        .Left = 20
        .Top = 20
        .Width = 640
        .Height = 100
    End With
    
    ppt.SaveAs Filename:="M:\7-CFR\6-SectionConduiteStages\SUIVI INSTRUCTION\ETATS STAGIAIRES\Commission\Commission_CDM.pptx"
End With

Next i
AppActivate "Excel"
Sheets(1).Select

 

[fanch55]

Bonjour,
J'ai testé votre code sans rencontrer aucun problème ...

 

[crackerwood]

Bonjour,
C'est bien ça le souci justement. Ca fonctionne que quand ça veut. J'ai essayé ce matin et ça a également fonctionné.
Je pense que cela a dû venir de l'ordinateur.
Merci quand même pour l'aide. Je vais attendre encore quelques jours pour voir si quelqu'un d'autre trouve une solution.

 

[Katido]

Bonjour,

J'ai déjà rencontré ce problème.
Je l'ai résolu d'une façon un peu bâtarde avec ce code (que tu pourras adapter à ton besoin) :

On Error Resume Next
Do
Err.Clear
FeuyP.Shapes(tx & nb).Copy
If Err = 0 Then Exit Do
DoEvents
Loop
Do
Err.Clear
FeuyJ.Paste FeuyJ.Cells(oj + 1, p)
If Err = 0 Then Exit Do
DoEvents
Loop
On Error GoTo 0

Ça plantait assez souvent avec le copy/paste direct, mais ça ne plantait plus avec cette parade (c'est plus une parade qu'une correction)

Le mieux est d'éviter les copier/coller,, ce que j'ai fait par la suite

 

[crackerwood]

Merci. Je testerais demain voir ce que ça donne. Le temps de décortiquer un peu le code et de l'adapter.
Je pense que le code de base que j'ai écris à l'air d'aller assez bien mais je pense que c'est plus la mémoire des copier coller qui pose problème.

 

[Katido]

Le principe est tout simple : on boucle sur le copy tant qu'il y a une erreur, puis on boucle sur le paste tant qu'il y a une erreur.
Ce serait mieux avec des For...Next qu'avec des Do...Loop car on en sortirait au bout de 20 tentatives par exemple si ça devait mal se passer.

 

[crackerwood]

Bonsoir. Alors j'ai voulu essayer la macro mais je n'ai eu que des bug. Alors je pense pas que la macro soit mauvaise. Je pense plutôt que mon code n'est pas compatible si on peut dire ça comme ça. Et je dois avouer que je n'ai pas trop envie de chercher des heures. J'essaierais sans doute de l'adapter pendant les vacances de Noël quand le fichier ne sera plus utiliser.

 

[Katido]

Les copy/paste ne portent pas sur le même objet, c'est pourquoi j'ai dit qu'il fallait adapter.

En fait tes 2 lignes :

ActiveSheet.Range("A1:Q37").Copy
newSlide.Shapes.PasteSpecial DataType:=2 'LIGNE QUI CREER LE BUG

Sont à remplacer par

On Error Resume Next
For ii=1 to 100
Err.clear
ActiveSheet.Range("A1:Q37").Copy
if Err=0 then Exit For
DoEvents
Next ii
For ii=1 to 100
Err.clear
newSlide.Shapes.PasteSpecial DataType:=2
if Err=0 then Exit For
DoEvents
Next ii
On Error GoTo 0

 

[crackerwood]

Bonjour,
Ah d'accord. J'étais à côté de la plaque totalement.
Je test ça dans la matinée.

EDIT : J'ai testé le code. Ca fonctionne parfaitement je n'ai plus de bug par contre nouveau souci. Toutes les slides du PPT sont vierge . Je devrais réussir à trouver mais je voulais quand même dire merci pour l'aide apporté.