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