宏Excel不会通过精确的图像到Powerpoint演示文稿

最奇怪的事情发生在我的宏在Excel中。 它的功能就像一个魅力，但是当它需要复制2个图表并粘贴到我的PowerPoint演示文稿中时，突然，图表不完全相同。

我的代码：

Set Wb = Workbooks.Open("PathWbName.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，不是一种形状 - 起初并不知道）

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

更奇怪的是，我在另一张工作簿上有另外两张图表，他们不会造成任何问题。

这可能是链接问题，或者我复制的方式？

UPDATE

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

 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中的方法，所以我将它粘贴到Excel表格“Temp”中。 并调整了阵列，这似乎工作。 但我仍然想知道如何直接在Powerpoint中执行此操作。

提前感谢您的见解！

---

我找不到可以解决问题的PasteSpecial选项。 CopyasPicture的作品，但我似乎无法弄清楚如何将其直接粘贴到PPT。 所以我使用了一种解决方法。 我创建了一个'Temp'表，在那里我可以以正确的格式粘贴Chart as Picture，之后我可以编程将它粘贴到Ppt中。 不是解决问题的最简洁的方式，但它起作用。

链接地址: http://www.djcxy.com/p/45685.html

上一篇: Macro Excel won't past exact image to Powerpoint Presentation

下一篇: Editting Column Name of Table in Embedded Excel OLE Object