Bonjour à tous,

J'ai fait le tour des discussion malheureusement je n'ai pas trouvé mon bonheur. J'ai crée une macro vba assez simple qui copie colle des graphes excel dans un power point prédéfinit.

La macro fonctionne bien puisque j'ai fait plusieurs fois l'opération avec succès sauf que:
-Elle n'a jamais fonctionné chez mes collègues
-Elle s'est arrêtée de fonctionner chez moi

==>Le message d'erreur est le suivant: Run time error '-2147417851 (80010105)':
Method 'Visible' of object '_Application' failed

==>Il apparait à la ligne ppapp.visible=msotrue en gras dans le code ci-dessous

J'ai bien vérifié que le les référencement de ppt dans la librairie est coché, j'ai changé calculation bref tout essayé mais depuis deux semaine ça ne veut plus tourner.

Je vous remercie d'avance pour votre aide,

Souley

Le code:



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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub test()


' Ajouter la référence à à Microsoft Powerpoint Library
   Dim sPPTRestitution As String
   Dim ppApp As PowerPoint.Application
   Dim ppPres As PowerPoint.Presentation
   Dim cht As Excel.ChartObject
   Dim tbl As Range
   
 
   'Sélectionner le fichier PowerPoint à ouvrir
     sPPTRestitution = Cells(3, 1).Value
 
   'Ouvrir PowerPoint
   
 Set ppApp = CreateObject("PowerPoint.Application")

   ppApp.Visible = msoTrue
   Set ppPres = ppApp.Presentations.Open(sPPTRestitution)
   ppApp.ActiveWindow.ViewType = ppViewSlide

 
 

 
   'Appel de la fonction pour copier graphique dans PowerPoint
   
   Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("synthese")
   Call copiercollergraph(ppPres, 5, cht, 110, -25)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("syntheseaxe")
   Call copiercollergraph(ppPres, 5, cht, 120, 220)

    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("gouvernance")
   Call copiercollergraph(ppPres, 9, cht, 125, -10)
   
     Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("gouvernanceaxe")
   Call copiercollergraph(ppPres, 9, cht, 120, 220)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("workplace")
   Call copiercollergraph(ppPres, 11, cht, 125, 0)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("workplaceaxe")
   Call copiercollergraph(ppPres, 11, cht, 120, 220)
   
   Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("datacenter")
   Call copiercollergraph(ppPres, 13, cht, 125, 0)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("datacenteraxe")
   Call copiercollergraph(ppPres, 13, cht, 120, 220)
   
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("network")
   Call copiercollergraph(ppPres, 15, cht, 120, 0)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("networkaxe")
   Call copiercollergraph(ppPres, 15, cht, 125, 220)
   
     Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("support")
   Call copiercollergraph(ppPres, 17, cht, 120, 0)
   
    Set cht = ThisWorkbook.Sheets("Analyse export").ChartObjects("supportaxe")
   Call copiercollergraph(ppPres, 17, cht, 125, 220)
   
   
   Set cht = Nothing
   Set cht = Nothing
   Set ppPres = Nothing
   Set ppApp = Nothing
   
   
   
   
End Sub
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
22
23
' Code pour copier le graphique spécifié dans la présentation
 
Sub copiercollergraph(oPPT As PowerPoint.Presentation, iSlideNo As Integer, cht As ChartObject, itop As Integer, ileft As Integer)
 
   Dim ppSlide As PowerPoint.Slide
   Dim pSh As PowerPoint.Shape
 
   'Choisir la diapositive
   Set ppSlide = oPPT.Slides(iSlideNo)
 
   cht.Copy
   With ppSlide
      .Shapes.Paste
      Application.CutCopyMode = False
      Set pSh = .Shapes(.Shapes.Count)  '.Select  'Select the last shape
   End With
 
   'Position et dimensions
   With pSh
      .Top = itop
      .Left = ileft
 
   End With