Macro Excel不会将确切的图像粘贴到Powerpoint演示文稿中

Question

我的Excel中的宏发生了最奇怪的事情。 它的工作原理就像一个魅力，但是当它必须复制2张图表并粘贴到我的PowerPoint演示文稿中时，突然之间，该图表并不完全相同。

我的代码：

Set Wb = Workbooks.Open("Path\WbName.xlsx", ReadOnly:=True, UpdateLinks:=0) 

它打开了另外5个工作簿...然后遍历一个循环，以复制所有图表

Dim Charts_Arr As Variant
    Charts_Arr = Worksheets("Parameters").ListObjects("Parameters").DataBodyRange.Value

For i = LBound(Charts_Arr) To UBound(Charts_Arr)
    SourcePath = Charts_Arr(i, 8)
    SheetName = Charts_Arr(i, 4)
    ShapeNr = Charts_Arr(i, 2)
    SlideNr = Charts_Arr(i, 3)
    Schaling = Charts_Arr(i, 6)

    Set Source = Workbooks(SourcePath)
    Set PPpres = oPPTApp.ActivePresentation
    Set Sh = Source.Sheets(SheetName).Shapes(ShapeNr)


    Sh.Copy


    Set NewSh = PPpres.Slides(SlideNr).Shapes.PasteSpecial(ppPasteJPG)
    With NewSh
      .Top = Charts_Arr(i, 5)
      .Left = Charts_Arr(i, 7)
      .ScaleHeight Schaling, msoTrue
    End With

Next i

这很完美。 但是当我看一下ppt文件时，有2张图表并不完全相同。

（提示：Excel是Chartarea，不是形状-起初不知道这一点）

手动复制图片时，我得到正确的图片：

更奇怪的是，我在同一工作簿的另一张工作表上还有另外两张图表，它们不会引起任何问题。

这可能是链接问题还是我的复制方式？

更新

如果我按照以下建议调整代码：

 Source.Sheets(SheetName).ChartObjects(ShapeNr).Chart.CopyPicture
        Set NewSh = PPpres.Slides(SlideNr).Shapes.Paste
            With NewSh
                        .Top = Charts_Arr(i, 5)
                        .Left = Charts_Arr(i, 7)
                        .ScaleHeight Schaling, msoTrue
            End With  

我得到这个：

我想代码的粘贴部分做错了。 尝试了其他可能性，总是最终没有图像，或者以上一种。

FIXERSUPDATE

所以我做了一个漏洞。 无法找到将图像直接粘贴到Powerpoint中的方法，因此我将其粘贴到excelsheet“临时”中。 并调整数组，这似乎起作用。 但是我仍然想知道如何直接在Powerpoint中执行此操作。

预先感谢您的见解！

Answer 1

我找不到可以解决该问题的PasteSpecial选项。 CopyasPicture可以工作，但是我似乎无法弄清楚如何将其直接粘贴到ppt中。 所以我使用了一种解决方法。 我创建了一个“临时”工作表，可以在其中以正确的格式将图表粘贴为图片，然后再对其编程以将形状粘贴到Ppt中。 不是解决问题的最干净的方法，但是它可以工作。