宏Excel不会将精确图像传递给Powerpoint Presentation

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＆＃39; Temp＆＃39;代替。并调整了数组，这似乎有效。但我仍然想知道如何在Powerpoint中直接执行此操作。

提前感谢您的见解！

Answer 1

我找不到可以解决问题的PasteSpecial选项。 CopyasPicture有效，但我似乎无法弄清楚如何将其直接粘贴到ppt中。所以我使用了一种解决方法。我创建了一个'Temp'表格，在那里我可以将Chart作为图片以正确的格式粘贴，之后我可以对其进行编程以将形状粘贴到Ppt中。不是解决问题最简洁的方法，但它确实有效。