将Excel图表复制为图片并粘贴到其他工作表中的范围

Question

我一直在尝试下面的代码将图表复制为图片，然后将其粘贴到另一个工作表中而不进行选择/激活。 但是似乎没有将图片粘贴到范围内：

Dim Range_DriverLookup As Range, RowCounter_DriverLookup As Long
Dim Count_DeliveredServicesNumber As Long, Counter_DeliveredServicesNumber As Long
Dim Cht_SitePotential As ChartObject
Dim Cht_Top5 As ChartObject
Dim Cht_RegionalPeerGroup As ChartObject
Dim PvtTbl_SitePotential As PivotTable
Dim PvtTbl_Top5 As PivotTable
Dim PvtTbl_RegionalPeerGroup As PivotTable
Dim Graph_PerformanceReport As Excel.Picture

'''''''''''''''''''''''''''''''''''''''''
' Assign ranges, pivottables and charts '
'''''''''''''''''''''''''''''''''''''''''
Set Range_DriverLookup = ThisWorkbook.Worksheets(SheetDriverLookup.Name).ListObjects("DriverLookup").DataBodyRange
Set PvtTbl_SitePotential = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableSitePotential")
Set PvtTbl_Top5 = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableTop5")
Set PvtTbl_RegionalPeerGroup = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).PivotTables("PivotTableRegionalPeerGroup")
Set Cht_SitePotential = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartSitePotential")
Set Cht_Top5 = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartTop5")
Set Cht_RegionalPeerGroup = ThisWorkbook.Worksheets(SheetPerformanceReportLookup.Name).ChartObjects("ChartRegionalPeerGroup")

'''''''''''''''''''''''''''''''''''
' Initiate new performance report '
'''''''''''''''''''''''''''''''''''
'// Clear previous graphs
For Each Graph_PerformanceReport In ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Pictures
    Graph_PerformanceReport.Delete
Next Graph_PerformanceReport
'// Clear previous sheet setup, and initiate new
Stop
With ThisWorkbook.Worksheets(SheetPerformanceReport.Name)
    '/ Unhide rows in PerformanceReport
    .Cells.EntireRow.Hidden = False
    '/ Clear previous "table of content"
    .Range("TableOfContent").ClearContents
    '/ Reset pagebreaks and set for new frontpage
    .ResetAllPageBreaks
    .Rows(71).PageBreak = xlPageBreakManual
End With

'// Set filters on frontpage graph
PvtTbl_SitePotential.ClearAllFilters
PvtTbl_SitePotential.PivotFields("Serviceline").AutoSort Order:=xlDescending, Field:="Potential Savings (Yearly) "
PvtTbl_SitePotential.PivotFields("Serviceline").ShowDetail = False
PvtTbl_SitePotential.PivotFields("Site").PivotFilters.Add Type:=xlCaptionEquals, Value1:=ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("Site").Value
PvtTbl_SitePotential.PivotFields("Serviceline").PivotFilters.Add _
Type:=xlValueIsGreaterThanOrEqualTo, DataField:=PvtTbl_SitePotential.PivotFields("Potential Savings (Yearly) "), Value1:=5000

'// Create title for frontpage graph
With Cht_SitePotential.Chart.ChartTitle
        .Caption = ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("Site") & " - Yearly Potential on Service Level"
End With

'// Paste frontpagegraph to PerformanceReport
With Cht_SitePotential.Chart
    .ChartArea.Copy
End With
ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("D7:D7").PasteSpecial xlPasteValues

用大部分代码进行编辑。

Answer 1

当我使用"P1:P1"模拟.Range("Frontpage_Graph")时，我无法为我工作

ThisWorkbook.Worksheets(SheetPerformanceReport.Name).Range("P1:P1").PasteSpecial ppPasteEnhancedMetafile

ppPasteEnhancedMetafile将提供更好的分辨率图表图片。

如果使用"P10:Z20"之类的范围，它将仅使用P10作为图表图片的定位点。