XL 2016 Export excel vers Powerpoint vba

[roybaf]

Bonjour à tous,

Je viens solliciter la communauté car je rencontre une difficulté que je n'arrive pas à résoudre seul.

Je fait un export de plusieurs objet vers powerpoint, méthode copy/paste.

Mon problème est que ma macro ne fonctionne pas tout le temps, parfois je ne vais avoir aucun problème et d'autre seul la moitié des éléments va se coller, je vais avoir une erreur "erreur invalid request The specified data type is unavailaible" Ce que je ne comprends pas c'est que ma macro fonctionne une fois sur deux.

Sub Export_Powerpoint()

Dim appPpt As Object 'la variable qui contiendra l'application
Dim Pptpre As Object 'la variable qui contiendra la présentation
Dim nbshpe As Byte
Dim shpe As Object 'pour manipuler un objet Forme
Dim sld As Object 'pour manipuler un objet diapositive
Dim MySlide As Slide

'-----------------------------------------------

Set appPpt = CreateObject("Powerpoint.Application")
appPpt.Visible = True


'l'application est créée et rendu visible

Set Pptpre = appPpt.Presentations.Open(Filename:=ThisWorkbook.Path & "\Testppt.potx")
Application.ScreenUpdating = False
Application.CutCopyMode = False

    Sheets("Tuilles").Select
    ActiveSheet.Range("B7:i17").Select
    Selection.Copy
    Pptpre.Slides(3).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(3).Shapes.Count
With Pptpre.Slides(3).Shapes(nbshpe)
    .Left = 96
    .Top = 120
    .Width = 500
    .Height = 350
End With
    Sheets("BilanN").Select
    ActiveSheet.Range("B5:C12").Select
    Selection.Copy
    Pptpre.Slides(5).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(5).Shapes.Count
With Pptpre.Slides(5).Shapes(nbshpe)
    .Left = 30
    .Top = 120
    .Width = 350
    .Height = 350
End With
    ActiveSheet.Range("B19:C26").Select
    Selection.Copy
    Pptpre.Slides(5).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(5).Shapes.Count
With Pptpre.Slides(5).Shapes(nbshpe)
    .Left = 292
    .Top = 120
    .Width = 350
    .Height = 350
End With
    ActiveSheet.Range("f29:g34").Select
    Selection.Copy
    Pptpre.Slides(5).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(5).Shapes.Count
With Pptpre.Slides(5).Shapes(nbshpe)
    .Left = 650
    .Top = 60
    .Width = 300
    .Height = 100
End With
    ActiveSheet.Range("b3:h4").Select
    Selection.Copy
    Pptpre.Slides(5).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(5).Shapes.Count
With Pptpre.Slides(5).Shapes(nbshpe)
    .Left = 60
    .Top = 60
    .Width = 900
    .Height = 40
End With
    ActiveSheet.Range("k2").Select
    Selection.Copy
    Pptpre.Slides(1).Shapes.PasteSpecial ppPasteMetafilePicture
    nbshpe = Pptpre.Slides(1).Shapes.Count
With Pptpre.Slides(1).Shapes(nbshpe)
    .Left = 180
    .Top = 135
    .Width = 600
    .Height = 60
End With

Set shpe = Pptpre.Slides(1).Shapes. _
AddTextbox(msoTextOrientationHorizontal, _
250, 60, 500, 50)
With shpe.TextFrame.TextRange
    .Text = Range("a1").Value
    .Font.Name = "garamond"
    .Font.Size = 50
    .Font.Bold = True
    .Font.Color = RGB(0, 0, 0)
    .Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
End With

Sheets("Parm").Select

End Sub

Merci d'avance pour vos réponses.

 

[sousou]

Bonjour
Il est possible que tu es un problème de timing.
L'ouverture de powerpoint et de son fichier peuvent se faire pas toujours dans le même temps alors, ajoute une attente après le Set Pptpre pour voir
A suivre...

 

[roybaf]

Bonjour,

Merci pour ta réponse, j'ai ajouté une attente de 3 secondes est toujours pareil, c'est arrivé à la slide 5 que ça plante mais pas toujours... j'ai entré le code :

Application.Wait Time + TimeSerial(0, 0, 3)

la première fois super, je l'ai relancé et hop le problème revient elle s'arrête à la slide 5.

 

[roybaf]

Bonjour
Il est possible que tu es un problème de timing.
L'ouverture de powerpoint et de son fichier peuvent se faire pas toujours dans le même temps alors, ajoute une attente après le Set Pptpre pour voir
A suivre...

Bonjour Merci pour ta réponse, j'ai ajouté un timing de 5 secondes mais toujours le même problème.

Le premier lancement c'est bien passé, j'ai voulu réessayer et hop ça plante, on dirait que c'est aléatoire, les erreurs ne sont pas sur les mêmes lignes, hier j'avais un problème "cardboard"...

 

[sousou]

dysfonctionnement aléatoire, je pense que c'est bien un rapport entre les deux applis
Essai un petit timing derrière tes collages, mais il est peut-être aussi possible de controler ma disponibilté de l'appli (je ne suis pas certain e)

 

[roybaf]

Bonjour,

J'ai essayé de mettre des timing entre chaque collage mais elle plante toujours, comment vérifier la disponibilité?

Merci

 

[roybaf]

Bonsoir à tous, quelqu'un aurait-il une piste pour moi je ne trouve pas de solution.

Merci d'avance

 

[roybaf]

Bonsoir à tous,

Je désespère de trouver une solution, j'ai recommencé tout mon projet et ma macro qui fonctionné très bien sur 3 diapos plante sur la 4ème, je ne comprends vraiment pas.