試圖將Excel中的圖表轉換爲圖片以將該圖紙從其源數據中導出

鋼板計算器的傳奇仍在繼續。所有的計算工作都非常好，在很大程度上要歸功於您在SO上的大量工作，但在最終導出階段，我發現如果源文件不再打開，顯示利用率優化的圖表會丟失其數據。試圖將Excel中的圖表轉換爲圖片以將該圖紙從其源數據中導出

我正在尋找一種方法來保持圖形在導出後保持靜態，理想情況下無需複製數據字段。理想的做法是將其轉換爲圖片，並保持其位置和大小。

我發現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

我也試過這一點，簡報宏的網站上發現和修改，以適應，但毫不奇怪，它在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）似乎更適合我的目的，但我該如何使它工作？有一種更簡單的方法嗎？

來源

2016-02-16 Andrew Perry

ppPastePng是一個用於PowerPoint的vba變量，所以它在Excel的VBA中沒有定義。

這應該工作：

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

來源

2016-02-16 12:02:42 ZwoRmi

我在''.Paste'行發現「不支持此屬性或方法」錯誤。其餘的工作很好（我把它與上面的'PasteGraph1'結合起來，這似乎工作得很好） - 我必須手動粘貼它，然後恢復處理宏。我已經刪除了'Cells（1,1）'位，現在它似乎工作。 –

順便說一句，任何想法如何保持（推測）基於矢量的圖表的銳利邊緣？位圖有點模糊 - 完全適合我的目的，但如果我能整理它，它會很好。 –

@AndrewPerry也許使用另一個'CopyPicture'選項，參見[this]（https://msdn.microsoft.com/fr-fr/library/office/ff841052.aspx） – ZwoRmi

（由作爲答案的完整性，接受@ 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

來源

2016-02-16 15:10:49

試圖將Excel中的圖表轉換爲圖片以將該圖紙從其源數據中導出

回答

相關問題