VBA：将excel范围粘贴到powerpoint占位符，而不使用.Select

Question

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

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

它通常有效，但有时会莫名其妙地失败。 我在这个网站的其他地方看过， 例如 ， 这里说要避免使用.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对象，包括设置Presentation和PPSlide 。

然后，它循环遍历PPSlide所有Shapes ，当它找到带有Name = "Picture"的Shape ，它会检索该工作表中形状的索引，因此它可以将Range对象直接粘贴到此Shape（作为Placeholder）。

码

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