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
| Public oPptD, PPapp, oPPTPres, Lshape As Object, Sh As PowerPoint.Shape, NrShapes As Long, wb As Workbook, sht As Worksheet
Public Sub CreatePowerpoint()
'On Error Resume Next
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set PPapp = CreateObject("PowerPoint.Application")
Set oPPTPres = PPapp.Presentations.Open _
("chemin\nom du fichier.ppt")
'Set oPptD = PPapp.ActivePresentation
'PPapp.Visible = True
Call createPPtParFeuil(Feuil1, "Graphique 8", 2, 300, 300, 50, 95)
Call createPPtParFeuil(Feuil1, "Graphique 1", 2, 300, 300, 400, 95)
Call createPPtParFeuil(Feuil18, "Graphique 2", 3, 300, 300, 50, 95)
Call createPPtParFeuil(Feuil18, "Graphique 1", 3, 300, 320, 360, 95)
Call createPPtParFeuil(Feuil19, "Graphique 2", 4, 300, 300, 50, 95)
Call createPPtParFeuil(Feuil19, "Graphique 1", 4, 300, 320, 360, 95)
Call createPPtParFeuil(Feuil27, "Graphique 11", 5, 300, 600, 50, 95)
Application.CutCopyMode = False
oPPTPres.SaveAs Filename:=wb.Path & "\" & Format(Date, "dd-mm-yyyy") & "_" & "nom.ppt"
Application.ScreenUpdating = True
End Sub
Sub createPPtParFeuil(ByVal nomFeuil, nomGraph As String, numSlide As Long, _
hautr As Long, largeur As Long, gauche As Long, top As Long)
nomFeuil.ChartObjects(nomGraph).Copy
With pptDoc
.Slides(numSlide).Shapes.Paste
With .Slides(numSlide).Shapes(.Slides(numSlide).Shapes.Count)
.Name = "nomGraph"
.Left = gauch
.top = top
.Height = hautr
.Width = largeur
End With
.Save
End With
End Sub |
Partager