копировать таблицу Excel в placeholder в Powerpoint

Question

Я пытаюсь скопировать диаграмму Excel в конкретный placeholder в Powerpoint. Я назвал заполнитель, используя следующий код

Sub NameShape() 
Dim Name$ 
On Error GoTo AbortNameShape 
If ActiveWindow.Selection.ShapeRange.Count = 0 Then 
    MsgBox "No Shapes Selected" 
    Exit Sub 
End If 
Name$ = ActiveWindow.Selection.ShapeRange(1).Name 
Name$ = InputBox$("Give this shape a name", "Shape Name", Name$) 
If Name$ <> "" Then 
    ActiveWindow.Selection.ShapeRange(1).Name = Name$ 
End If 
Exit Sub 
AbortNameShape: 
    MsgBox Err.Description 

End Sub 

В Excel я пришел, насколько это:

Sub CreateNewReport() 
Dim pptApp As PowerPoint.Application 
Dim pptPres As PowerPoint.Presentation 
Dim pptSlide As PowerPoint.Slide 
Dim pptShape As PowerPoint.Shape 
Dim w!, h!, t!, l! 
Dim Chart As Chart 


Set pptApp = CreateObject("PowerPoint.Application") 
pptApp.Visible = msoTrue 
Set pptPres = pptApp.Presentations.Open("C:\Users\...\Report.pptm") 
Set Chart = Worksheets("Analysts").ChartObjects("Chart 2") 
Set PPSlide = pptPres.Slides(4) 
'PPSlide.Shapes("Analyst.Forecasts").Copy 
Set pptShape = pptPres.Slides(4).Shapes(4) 
With pptShape 
    w = .Width 
    h = .Height 
    l = .Left 
    t = .Top 
    End With 
pptShape.Parent.Paste 
    With Selection 
    .Width = w 
    .Height = h 
    .Left = l 
    .Top = t 
    End With 
ppt.Shape.Delete 
End Sub 

Кто-нибудь знает, как сделать это здесь? Я не могу понять, как определить график, который я хочу скопировать, и как вставить & замените shep в Powerpoint. В идеале я хотел бы заменить его метафайлом диаграммы, но и картина в порядке.

Большое вам спасибо за помощь!

Answer 1

Я использую этот код, чтобы сделать ppt из Excel и вставить placeHolder;

Nr = 2 

'Verifique os graficos nos arquivos 
    For Each Grf In E.ActiveSheet.ChartObjects 
     Grf.Copy 
     Sld.Shapes.Placeholders(Nr).Select msoCTrue 
     P.ActivePresentation.Windows(1).View.PasteSpecial (ppPasteMetafilePicture) 
     Nr = Nr + 1 
    Next Grf 

End If