【发布时间】：2017-12-16 00:10:04
【问题描述】：
基本上，我正在尝试使用 Excel 中的范围在 PowerPoint 中自动生成一组自定义布局。按照此代码，我可以遍历预定义范围内的所有形状，将预定义范围内的形状复制到新创建的演示文稿中的自定义布局中。
我的问题是它从 Excel 复制到 Powerpoint 的任何内容都会变成图片而不是形状。
这是我的代码的一部分：
Dim WS As Worksheet
Dim PPT As Object
Dim PRES As Object
Dim PPTlay As Object
Dim shp As Shape
Dim r as Range
Set WS = ActiveWorksheet
Set r = WS.Range("A1:L36")
'New PPT Presentation
On Error Resume Next
Set PPT = GetObject(class:="PowerPoint.Application")
On Error GoTo 0
If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")
Set PRES = PPT.Presentations.Add
PRES.PageSetup.SlideSize = ppSlideSizeOnScreen
'Delete all layouts in slideMaster
For i = PRES.SlideMaster.CustomLayouts.Count To 1 Step -1
PRES.SlideMaster.CustomLayouts(i).Delete
Next i
'Create new custom layout
Set PPTlay = PRES.SlideMaster.CustomLayouts.Add(PRES.SlideMaster.CustomLayouts.Count + 1)
'Delete all placeholders and shapes on newly created custom layout
For i = PPTlay.Shapes.Count To 1 Step -1
PPTlay.Shapes(i).Delete
Next i
'Loop through all shape in Excel range "r"
'Copy/paste to powerpoint custom Layout
For Each shp In WS.Shapes
If Not Intersect(WS.Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then
shp.Select
Selection.Copy
PPTlay.Shapes.Paste
i = PPTlay.Shapes.Count
PPTlay.Shapes(i).LEFT = shp.LEFT
PPTlay.Shapes(i).TOP = shp.TOP
End If
Next shp
我还尝试选择范围内的所有形状，复制选择，然后将其粘贴到演示文稿中，但发生了同样的问题。
欢迎任何提示。
谢谢！
【问题讨论】：
标签： excel vba powerpoint copy-paste shapes