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也一样，所以我想创建一个新图表并粘贴到它中一定很奇怪。

Excel VBA在复制为图像

1 个答案: