Copier Coller tableaux excel dans power point

Bonjour à tous,

Je début en VBA et en ce moment j'essaye de créer une macro qui ouvre tous les fichiers d'un dossier pour copier/coller un tableau en particulier dans un power point. Tout marche bien SAUF pour la partie où la macro doit Coller en image sur le PPT.
Pouvez-vous m'aider svp?

Merci d'avance.

Voici ma macro :

Code:

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
Sub Copier_coller()
 
 
Dim Ppt As Object 'la variable qui contiendra l'application
Dim presentation As Object 'la variable qui contiendra la présentation
Dim nbshape As Byte
nbshape = 0
Dim shape As Object 'pour manipuler un objet Forme
Dim slide As Object 'pour manipuler un objet diapositive
 
 
Dim PositionGauche As Integer
Dim PositionHaut As Integer
Dim Largeur As Integer
 
Dim i As Integer
Dim j As Integer
Dim k As String
 
j = 0
 
'création de l'application Powerpoint
Set Ppt = CreateObject("Powerpoint.Application")
Ppt.Visible = True
 
'on s'interesse à la présentation ouverte
Set presentation = Ppt.ActivePresentation
 
'on récupère la position et la taille voulue pour les tableaux Synthèse
 Sheets("Macro").Select
    Range("Positiongauche").Select
    Selection.Copy
    PositionGauche = Selection
 
    Range("Positionhaut").Select
    Selection.Copy
    PositionHaut = Selection
 
    Range("Positionlargeur").Select
    Selection.Copy
    Largeur = Selection
 
' macrocopiecolle Macro
'
 
    Sheets("Macro").Select
 
    i = Range("C5")
 
    name = Range("B5")
 
 
While i <> "0"
ActiveSheet.Calculate
 
    Workbooks.Open Filename:= _
        "W:\Budget 2016\5. Fichiers Cash Ebitda\Budget " & (name) & ".xlsm", UpdateLinks:=0
 
    Sheets("OCF_presentation").Select
    Range("Synthèse").Select
    Selection.Copy
 presentation.Slides(i).Shapes.PasteSpecial (ppPasteEnhancedMetafile)
  nbshape = presentation.Slides(i).Shapes.Count
    With presentation.Slides(i).Shapes(nbshape)
            .name = "Synthèse"
            .Left = PositionGauche
            .Top = PositionHaut
            .Width = Largeur
            .ZOrder msoSendToBack
    End With
 
 
 
    Windows("Recap Budget pays.xlsm").Activate
    j = j + 1
    i = Range("C" & (j + 5))
    name = Range("B" & (j + 5))
    Wend
 
End Sub