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。

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

代码

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

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

1 个答案: