Excel VBA在復制為圖像之前更改圖

Question

我一直在使用宏一次復制多個Excel圖表，因此在報告過程中可以將它們手動粘貼到OneNote中。 但是，切換到Office 365后，一切都變得非常奇怪。

首先，在它們各自的工作表上創建所有這些圖表，然后創建一個宏，將所有圖表合並到一張工作表中。 此宏創建一個新的工作表（rpt_sht），對於要復制的每個圖表，它在rpt_sht頁上創建一個新圖表，復制原始圖表並將其粘貼到rpt_sht頁上的新創建的圖表中。

' create a new chart on the report page
Set sh = rpt_sht.Shapes.AddChart(, rpt_rng.Left, rpt_rng.Top, w, h)
' select and copy the data from the original chart
' Charts are awful so you gotta do all this so it actually copies
wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Activate
wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Select
For Each srs In wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Chart.SeriesCollection
    names.Add (srs.Name)
Next
DoEvents
wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Copy
DoEvents
' and since charts are still awful, do all this awful stuff to paste it
rpt_sht.Activate
rpt_rng.Activate
sh.Select
sh.Chart.Paste
' so the right series names actually show up
For k = names.Count To 1 Step -1
    sh.Chart.SeriesCollection(k).Name = names(k)
    sh.Chart.SeriesCollection(k).MarkerSize = 3
    names.Remove (k)
Next k

然后，我在rpt_sht頁面上有幾個按鈕，可用於分組，復制為位圖以及取消分組這些圖表的不同組合。

With ws.Shapes.Range(names).Group
    .CopyPicture Format:=xlBitmap
    .Ungroup
End With

出現兩個問題：

1）在工作表之間復制圖表時，圖表圖例從使用數據系列名稱更改為使用系列1，系列2等。我能夠通過在復制之前將名稱保存在集合中然后重新命名所有內容來解決此問題。粘貼后，但我覺得這不應該發生。

2）當我在圖紙之間或作為位圖進行復制時，標記大小僅在某些系列中隨機變化。 粘貼rpt_sht后，將它們全部設置為3，但是當我嘗試復制為位圖時，問題仍然存在。

當我手動執行相同的操作時，這些事情都不會發生。 確實，我已經能夠解決工作表之間的復制/粘貼問題，但是現在該系列在作為位圖復制后會更改大小，並且我很難解決該問題。

所以問題是，為什么會這樣？我該如何避免呢？

Answer 1

通過復制圖表並將其粘貼到工作表而不是空白圖表，我能夠解決工作表間的問題。 不過，您似乎無法粘貼到單元格。 對於定位，工作表粘貼方法具有一個目標參數，我用於指定圖表左上角的位置。

wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Activate
wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Select
wbk.Worksheets(shts(i)).ChartObjects(chts(i)).Copy
' paste the chart to the report page in the rpt_rng cell
rpt_sht.Paste rpt_rng
' get access to the chart and set the size
Set co = rpt_sht.ChartObjects(chts(i))
co.Width = w
co.Height = h

完成此操作后，復制到OneNote的效果也很好，因此我想創建新圖表並將其粘貼到其中一定很奇怪。