Question

基本上，我尝试在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

我还尝试选择范围内的所有形状，复制选择，然后将其粘贴到演示文稿中但发生了同样的问题。

欢迎任何提示。

谢谢！

Answer 1

尝试

PPTlay.Shapes.PasteSpecial DataType:= ppPasteShape

而不是

PPTlay.Shapes.Paste

有没有办法从excel复制形状并将它们粘贴为Powerpoint中的相同形状类型？

1 个答案: