VBA：将excel范围粘贴到powerpoint占位符而不使用。选择

Question

我想在自定义布局中将指定的excel范围粘贴到powerpoint中的内容占位符。我目前使用这样的代码

ranger.Copy 
currentPPT.ActiveWindow.View.GotoSlide ppt.slides.Count 
activeSlide.shapes("Picture").Select msoTrue 
ppt.Windows(1).View.PasteSpecial (ppPasteEnhancedMetafile) 

它通常工作，但有时莫名其妙地失败。我在本网站的其他地方看过，here for example，说避免使用.Select方法。而是使用类似于

Dim oSh As Shape 
Set oSh = ActivePresentation.Slides(9).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1) 

但是，我无法弄清楚如何使用第二种方法直接复制到内容占位符。那可能吗？

编辑，关于Shai的建议。当前的代码是

For ii = activeSlide.shapes.Count To 1 Step -1 
If activeSlide.shapes.Item(ii).Name = "Picture" Then 
    shapeInd = ii 
    Exit For 
End If 
Next ii 

Set oSh = activeSlide.shapes.PasteSpecial(2, msoFalse)(shapeInd) 

“图片”形状是一个“内容”占位符。另外两个形状是文本框。

Answer 1

以下代码将按照您在文章中提到的方式进行操作。

首先它会创建所有必需的PowerPoint对象，包括设置演示文稿和PPSlide。

然后，它遍历在PPSlide所有Shapes，并且当它发现Shape与Name = "Picture"它检索在片材的形状的指数，因此它可以在Range对象直接粘贴到这个形状（作为占位符）。

代码

Option Explicit 

Sub ExporttoPPT() 

Dim ranger   As Range 
Dim PPApp   As PowerPoint.Application 
Dim PPPres   As Presentation 
Dim PPSlide   As Slide 
Dim oSh    As Object 

Set PPApp = New PowerPoint.Application 
Set PPPres = PPApp.Presentations("PPT_TEST") ' <-- change to your open Presentation 
Set PPSlide = PPPres.Slides(9) 

Set ranger = Worksheets("Sheet1").Range("A1:C5")  
ranger.Copy 

Dim i As Long, ShapeInd As Long 

' loop through all shapes in Slide, check for Shape Name = "Picture" 
For i = PPSlide.Shapes.Count To 1 Step -1 
    If PPSlide.Shapes.Item(i).Name = "Picture" Then 
     ShapeInd = i '<-- retrieve the index of the searched shape 
     Exit For 
    End If 
Next i 

Set oSh = PPSlide.Shapes.PasteSpecial(2, msoFalse)(ShapeInd) ' ppPasteEnhancedMetafile = 2 

End Sub