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 |
Partager