Discussion :

[Val2000]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 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.

[PMO2017]

Bonjour,

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

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
'### 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.

[Val2000]

C'est parfait, merci beaucoup!

[Val2000]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
OpenClipboard 0
EmptyClipboard
CloseClipboard

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set AppPP2 = Nothing
Set PR2 = Nothing

As-tu une idée?

[Val2000]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
PR2.Close
Set PR2 = Nothing
 
AppPP2.Quit
Set AppPP2 = Nothing