Discussion :

[Kam's11]

Bonjour,

Je suis novice en ce qui concerne l'utilisation de Powerpoint via les macros Excel.

J'ai commencé par créer un code et je suis rapidement tombé sur un os.
Je voudrais coller un tableau excel en collage spécial, mode image (métafichier améliorer) sur un slide powerpoint.

Voici mon code qui marche très bien jusqu'au collage de l'image :

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
Private Sub Trsft_PowerPoint_Click()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppShape As PowerPoint.Shape
Dim SlideNum As Integer
Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
    strPresPath = "C:\..."
    strNewPresPath = "C:\..."
 
Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = msoTrue
Set ppPres = ppApp.Presentations.Open(strPresPath)
 
    Sheets("Sheet1").Activate
    Range("B2:R27").Copy
 
Set ppSlide = ppPres.Slides.Add(18, ppLayoutText)
    SlideNum = 18
    ppPres.Slides(SlideNum).Select
    ppt.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
 
 
MsgBox "Présentation Créée", vbOKOnly + vbInformation
 
End Sub

Lorsque je lance la macro, j'ai un message qui me dit qu'un objet est requis

Quelqu'un peut-il m'aider ?

[Kam's11]

En faites j'ai fini par trouvé la réponse : je suis un boulet

Voici le bon 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
Private Sub Trsft_PowerPoint_Click()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppShape As PowerPoint.Shape
Dim ppSlide As PowerPoint.Slide
Dim SlideNum As Integer
 
Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
    strPresPath = "C:\...ppt"
    strNewPresPath = "C:\...ppt"
 
Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = msoTrue
Set ppPres = ppApp.Presentations.Open(strPresPath)
 
    Sheets("sheet1").Activate
    Range("B2:R27").Copy
 
Set ppSlide = ppPres.Slides.Add(18, ppLayoutBlank)
    SlideNum = 18
    ppPres.Slides(SlideNum).Select
    ppPres.Slides(SlideNum).Shapes.PasteSpecial ppPasteEnhancedMetafile
    With ppPres.Slides(SlideNum).Shapes(1)
        .IncrementLeft 524#
        .IncrementTop 157.5
    End With
    ActiveWindow.LargeScroll ToRight:=1
    With ppPres.Slides(SlideNum).Shapes(1)
        .ScaleWidth 0.62, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft
    End With
 
MsgBox "Présentation Créée", vbOKOnly + vbInformation
 
End Sub

Il y a certainement meilleure en qualité de code mais ca marche ...

[hbc99]

J'essaye de copier collée un tableau depuis powerpoint vers Excel mais le bug ne débug pas Any solution?

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
Private Sub Trsft_PowerPoint_Click()
 Dim ppApp As PowerPoint.Application
 Dim ppPres As PowerPoint.Presentation
 Dim ppShape As PowerPoint.Shape
 Dim ppSlide As PowerPoint.Slide
 Dim SlideNum As Integer

 Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
 strPresPath = "P\National\_ApplicationData\WealthManagement-FLWM\se-Lux Exec Plateform\se-Produits Structurés\Oulfa\02- Project\Product Agreement - Memory Phoenix - V3 - version definitive.pptx"
 strNewPresPath = "P\National\_ApplicationData\WealthManagement-FLWM\se-Lux Exec Plateform\se-Produits Structurés\Oulfa\02- Project\Product Agreement - Memory Phoenix - V3 - version definitive.pptx"

 Set ppApp = CreateObject("PowerPoint.Application")
 ppApp.Visible = msoTrue
 Set ppPres = ppApp.Presentations.Open(strPresPath) 

Sheets("sheet1").Activate
 Range("A1:B27").Copy

 Set ppSlide = ppPres.Slides.Add(4, ppLayoutBlank)
 SlideNum = 4
 ppPres.Slides(SlideNum).Select
 ppPres.Slides(SlideNum).Shapes.PasteSpecial ppPasteEnhancedMetafile
 With ppPres.Slides(SlideNum).Shapes(1)
 .IncrementLeft 524#
 .IncrementTop 157.5
 End With
 ActiveWindow.LargeScroll ToRight:=1
 With ppPres.Slides(SlideNum).Shapes(1)
 .ScaleWidth 0.62, msoFalse, msoScaleFromTopLeft
 .ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft
 End With

 MsgBox "Présentation Créée", vbOKOnly + vbInformation

 End Sub