Question

钢板计算器的传奇继续。所有的计算工作都非常好，在很大程度上要归功于你在SO上，但在最后的导出阶段，我发现如果源文件不再打开，显示利用率优化的图表会丢失其数据。

然后，我正在寻找一种在导出后保持图形静态的方法，理想情况下无需复制数据字段。理想的做法是将其转换为图片，保持其位置和大小。

我在SO上找到了this，但它创建了一个新的图形，显然是一个饼图格式：

Sub PasteGraph2()
Dim ws As Worksheet
Dim cht As Chart

Set ws = ActiveSheet
Set cht = ws.Shapes.AddChart.Chart
With cht
    .SetSourceData ws.Range("$B$21:$C$22")
    .ChartType = xl3DPie
    .ChartArea.Copy
End With
ws.Range("A2").PasteSpecial xlPasteValues
cht.Parent.Delete
End Sub

我也试过这个，在Powerpoint宏的网站上找到并修改为适合，但不出所料它在Excel中不起作用（“ppPastePNG - 变量未定义”）。

Sub PasteGraph1()
' PasteGraph Macro

Dim oGraph As Shape
Dim oGraphPic As Shape
Dim dGrpLeft As Double
Dim dGrpTop As Double

oGraph = ActiveSheet.ChartObjects("Chart 3").Copy
    dGrpLeft = oGraph.Left
    dGrpTop = oGraph.Top
    oGraph.Copy
    ActiveSheet.Shapes.PasteSpecial DataType:=ppPastePNG
    Set oGraphPic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    oGraph.Delete
    oGraphPic.Left = dGrpLeft
    oGraphPic.Top = dGrpTop

End Sub

后者（PasteGraph1）似乎更适合我的目的，但我该如何使其发挥作用？有更简单的方法吗？

Answer 1

ppPastePng是PowerPoint的vba变量，因此未在VBA for Excel中定义。

这应该有效：

ActiveSheet.ChartObjects("Chart 3").Chart.CopyPicture xlScreen, xlBitmap
ActiveSheet.Paste

Answer 2

（作为完整性的答案添加，接受了@ ZwoRmi的回答，因为看起来很粗鲁并不认为他的建议对于使其起作用至关重要......）

非常感谢@ZwoRmi解决这个问题的关键 - 这是我最终使用的代码，它是原始PasteGraph1方法和@ZwoRmi更有用的复制方法的组合和调整。

Sub PasteGraph1()
' Converts live graph to static image

Dim oGraphPic As Shape
Dim dGrpLeft As Double
Dim dGrpTop As Double

    dGrpLeft = ActiveSheet.ChartObjects("Chart 1").Left
    dGrpTop = ActiveSheet.ChartObjects("Chart 1").Top

    ActiveSheet.ChartObjects("Chart 1").Chart.CopyPicture xlScreen, xlBitmap
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Delete
    Set oGraphPic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    oGraphPic.Left = dGrpLeft
    oGraphPic.Top = dGrpTop

End Sub

尝试将Excel中的图表转换为图片，以将该图表从其源数据中导出

2 个答案: