Sub CopyChart()
Dim wb As Workbook, ws As Worksheet
Dim oPPTPres As PowerPoint.Presentation
Dim myPPT As String
Dim shp As Shape
Dim strShapename As String
myPPT = "C:\test.pptx"
Set ppApp = CreateObject("PowerPoint.Application")
Set oPPTPres = ppApp.Presentations.Open(Filename:=myPPT)
ppApp.Visible = True
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
Call FillPP(oPPTPres, 2, ws.Shapes(5), ws.Shapes(6), ws.Shapes(7), ws.Shapes(8))
End Sub
Function FillPP(pPres As Presentation, SlideNo As Long, ParamArray cCharts())
Dim oSh As Shape
Dim pSlide As Slide
Dim lLeft As Long, lTop As Long
Dim i As Long
Dim oPPTPres As Presentation
Application.CutCopyMode = False
Set pSlide = pPres.Slides(SlideNo)
For i = 0 To UBound(cCharts)
cCharts(i).Copy
ppApp.ActiveWindow.View.GotoSlide SlideNo
pSlide.Shapes.Paste
Application.CutCopyMode = False
If i = 0 Then ' 1st Chart
lTop = 0
lLeft = 0
ElseIf i = 1 Then ' 2nd Chart
lTop = 0
lLeft = 360
ElseIf i = 2 Then ' 3th Chart
lTop = 216
lLeft = 0
ElseIf i = 3 Then ' 4th Chart
lTop = 216
lLeft = 360
End If
pSlide.Shapes(cCharts(i).Name).Left = lLeft
pSlide.Shapes(cCharts(i).Name).Top = lTop
Next i
'Set oSh = Nothing
'Set pSlide = Nothing
'Set oPPTPres = Nothing
'Set ppApp = Nothing
'Set pPres = Nothing
End Function
Здесь я заполняю слайды в powerpoint диаграммами из листа excel. В вызове функции FillPP в качестве параметров явно перечислены диаграммы, которые хочется засунуть в массив перед передачей. Если массив с текстовой информацией удается создать, то с объектами типа shape не получается. Помогите сделать что-то типа:
Код
dim massiv as variant
For i = 0 To 3
massiv(i) = ws.Shapes(i + 1)
Next i
Call FillPP (oPPTPres, 2, massiv())
Не забывайте, что любая фигура и диаграмма это объект
Код
dim aShapes
ReDim aShapes(0 to 3)
'здесь можно и циклом, но принцип понятен
set aShapes(0) = ws.Shapes(5)
set aShapes(1) = ws.Shapes(6)
set aShapes(2) = ws.Shapes(7)
set aShapes(3) = ws.Shapes(8)
Call FillPP(oPPTPres, 2, aShapes)
забыл. Не забудьте после такого подхода изменить тип аргумента в функции:
Код
Function FillPP(pPres As Presentation, SlideNo As Long, cCharts)