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 48 49 50 51 52 53 54 55 56 57
|
Public wbk As Workbook
Sub copyrange(ByRef tocopyAs Object, sd As Object, l As Double, t As Double, w As Double, _
h As Double, PpPasteDataType As Long)
Dim newshape As Object
tocopy.Copy
Set newshape = sd.Shapes.PasteSpecial(DataType:=PpPasteDataType)
newshape.Left = l
newshape.Top = t
newshape.Height = h
newshape.Width = w
End Sub
Sub exportfromexceltoppt(templatepath, sld As Object, excelname As String, s As String, r As String, l As Double, t As Double, w As Double, _
h As Double)
Dim x As Object
Call OpenWorkbook(excelname, wbk)
Set x = wbk.Sheets(s).Range(r)
Call copyrange(x, sld, l, t, w, h, 2)
End Sub
Sub main()
Dim i As Integer, slidenumber As Integer
Dim app
Dim pres
Dim templatepath
Dim slide As Object
templatepath = Workbooks("template ppt power").Worksheets("Feuil1").Range("A2")
Set app = CreateObject("Powerpoint.Application")
Set pres = app.Presentations.Open(templatepath)
With Workbooks("template ppt power").Worksheets("Feuil1")
For i = 6 To 10
slidenumber = .Range("B" & i)
Set slide = pres.slides(slidenumber)
Call exportfromexceltoppt(templatepath, slide, .Range("C" & i), .Range("d" & i), .Range("e" & i), .Range("f" & i), .Range("g" & i), .Range("h" & i), _
.Range("i" & i))
Next i
End With
End Sub |
Partager