Question

我正在尝试将Excel图表复制到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

有谁知道怎么从这里拿走它？我无法弄清楚如何定义我想要复制的图表以及如何粘贴＆amp;替换Powerpoint中的shep。理想情况下，我想用图表的图元文件替换它，但是图片也可以。

非常感谢你的帮助！

Answer 1

我使用此代码从Excel制作ppt并粘贴到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

将Excel图表复制到Powerpoint中的占位符

1 个答案: