Insertion d'un slide ppt dans Excel

Bonjour,
J'essaie d'insérer un slide d'une présentation powerpoint dans un fichier Excel via une macro mais sans succès. J'ai essayé avec

Code:

---

ActiveSheet.OLEObjects.Add(Filename:="X:\Y\Z\Fichier", Link:=False, DisplayAsIcon:=False).Select

---

mais il me faudrait la copie d'un seul slide seulement.
Est-ce que quelqu'un sait comment faire?
Merci d'avance.

Bonjour,

Une piste avec le code suivant à copier dans un module standard.
Il faudra adapter les parties de code cernées par des ###

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

'### Adapter le chemin du .ppt dans la constante ci-dessous ### Const PATH_FICHIER_POWERPOINT As String = "c:\test.ppt" '##############################################################   '--- Apis pour le presse-papiers --- Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long) Private Declare Function EmptyClipboard& Lib "user32" () Private Declare Function CloseClipboard& Lib "user32" () '-----------------------------------   Sub CopierUneDiapo() Dim AppPP As Object 'PowerPoint.Application Dim PR As Object 'PowerPoint.Presentation '--- On Error GoTo Erreur Set PR = GetObject(PATH_FICHIER_POWERPOINT) Set AppPP = PR.Application PR.Slides(7).Copy '### adapter le numéro de la diapositive ( Slides(x) ) ### ActiveSheet.PasteSpecial Format:="Objet Diapositive Microsoft PowerPoint", _ Link:=False, DisplayAsIcon:=False '--- Nettoyage (ferme les variabless Object) --- Erreur: If Not PR Is Nothing Then PR.Close Set PR = Nothing End If If Not AppPP Is Nothing Then AppPP.Quit Set AppPP = Nothing End If If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description '--- Vide le presse-papiers --- OpenClipboard 0 EmptyClipboard CloseClipboard End Sub

---

Bon courage et à plus.

C'est parfait, merci beaucoup!

Re-bonjour,
En fait, je n'arrive pas à vider mon presse-papiers. J'ai copié tes lignes

Code:

---

1 2 3

Declare Function OpenClipboard& Lib "M887766" (ByVal hwnd As Long) Declare Function EmptyClipboard& Lib "M887766" () Declare Function CloseClipboard& Lib "M887766" ()

---

avec à la fin

Code:

---

1 2 3

OpenClipboard 0 EmptyClipboard CloseClipboard

---

Ceci déclenche ma message d'erreur, il ne veut pas à partir de la ligne

Code:

---

OpenClipboard 0

---

.
Pour l'application, je suis toujours dans le fichier (il n'est accessible seulement en lecture seule).
J'ai aussi essayé avec

Code:

---

1 2	Set AppPP2 = Nothing Set PR2 = Nothing

---

As-tu une idée?

J'ai fait trop vite... Comme ça, ça marche.Il faut bien d'abord fermer/quitter et ensuite vider.

Code:

---

1 2 3 4 5

PR2.Close Set PR2 = Nothing   AppPP2.Quit Set AppPP2 = Nothing

---