Discussion :

[Bepincho]

Bonjour,

Cela fait une semaine que je tente de résoudre mon problème et je suis vraiment sans solution. Mes macros tournaient depuis des années sans soucis mais le 16 avril dernier, on a eu une mise à jour d'entreprise et le lendemain plus rien ne fonctionnait.

La macro consiste à copier un graphique croisé dynamique dans un PPT. J'ai deux feuilles qui entrent en jeu :

Graph data total = liste tous les produits, les m² vendus et les prévisions de ventes. En E1, j'ai une liste de client qui changera via la macro.

Graph total externe = j'ai un TCD qui se base sur la feuille précédente. Un segment filtre les catégories et un autre exclut les valeurs zéro. Une fois les filtres appliqués, je créé un graphique dynamique. En A1, je reprends la valeur E1 de la feuille précédente. Le titre du graphique suit la même logique.

En pièces jointes, je mets l'erreur que je rencontre et les bibliothèques qui sont actives en VBA. Voici mon 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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Sub Client1DB()
'
' Client1 Macro
'
 
'----------------------------------------
' All categories
'----------------------------------------
 
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.MissingItemsLimit = xlMissingItemsNone
 
    Sheets("Graph data total").Select
    Range("E1").Value = "Client1"
    Sheets("Graph total externe").Select
 
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
    ActiveWorkbook.SlicerCaches("Segment_Category1").ClearManualFilter
    ActiveWorkbook.SlicerCaches("Segment_flag1").ClearManualFilter
 
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
 
    With ActiveWorkbook.SlicerCaches("Segment_flag1")
 
            For i = 1 To .SlicerItems.Count
 
                If .SlicerItems(i).Name = " -   " Then
                    .SlicerItems(i).Selected = False
 
                Else
                    .SlicerItems(i).Selected = True
 
                End If
 
            Next
 
    End With
 
'------------------------------------------
'L'application est créée et rendue visible
'------------------------------------------
 
Dim appPpt As Object 'la variable qui contiendra l'application
Dim Pptpre As Object 'la variable qui contiendra la présentation
 
Set appPpt = CreateObject("Powerpoint.Application")
    appPpt.Visible = True
 
'----------------------------------------------------
'Copier le graphique dans la présentation powerpoint
'----------------------------------------------------
 
Set Pptpre = appPpt.Presentations.Open("C:\Users\O9831898\OneDrive - Saint-Gobain\Bureau\\ClefUSB\Planning\Dashboards\Client1Template.pptx")
 
 
    Sheets("Graph total externe").Select
    ActiveSheet.ChartObjects("Graphique 3").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
    Pptpre.Slides(1).Shapes.PasteSpecial ppPasteMetafilePicture
 
    With Pptpre.Slides(1).Shapes(1)
 
    .Left = 0
    .Top = 40
    .Width = 700
    .Height = 450
 
    End With
 
'---------------------------------------------------------------
'La présentation Powerpoint est sauvegardée sous un nouveau nom
'---------------------------------------------------------------
 
    Application.DisplayAlerts = False
 
 Pptpre.SaveAs Filename:=("C:\Users\O9831898\OneDrive - Saint-Gobain\Bureau\\ClefUSB\Planning\Dashboards" & "Client1 - " & Format(Now(), "yyyymmdd") & ".pptx")
 
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
 
Pptpre.Close
'appPpt.Quit
'Set appPpt = Nothing
 
 
End Sub

Pour certains clients, j'ai parfois plusieurs diapositives pour gagner en visibilité mais la logique reste la même. Auriez-vous une solution pour que je puisse avancer sur ce sujet ?

Un tout grand merci d'avance pour votre aide.

Bien à vous.




Olivier.

[barpasc]

Erreur shapes.pastespecial

Ca me semble être une méthode qui ne s'applique pas à l'objet shapes. Peut-être que cette erreur n'était pas relevé dans les versions précédentes.

Soit débugger le code en commençant par shapes, appliquer un point d'arrêt à chaque appel de l'objet et vérifier le contenu.

Sinon les macros vba qui utilisent abondamment les méthodes des tcd et des graphs "souffrent" du passage d'une version à l'autre d'excel, exemple le code fonctionne sur une version mais pas sur une autre.

Mais si c'est une maj de windows, c'est un peu plus compliqué

En dernière réponse, utiliser une machine virtuelle avec la configuration qui fonctionne

[Bepincho]

J'ai trouvé sur un site une solution d'un utilisateur qui avait rencontré le même problème au mois de mars. J'ai remplacé l'instruction ppPasteMetafilePicture par ppPasteEnhancedMetafile et la macro tourne de nouveau.