Excel VBA在复制为图像之前更改打印

Excel VBA在复制为图像之前更改打印,vba,excel,Vba,Excel,我一直在使用宏一次复制多个Excel图表,以便在报告过程中手动将它们粘贴到OneNote中。然而,在切换到Office 365之后,一切都变得非常奇怪 我首先在各自的工作表上创建所有这些图表,然后有一个宏将所有图表合并到一个工作表上。此宏将创建一个新的工作表(rpt_sht),对于我要复制的每个图表,它将在rpt_sht页面上创建一个新图表,复制原始图表并将其粘贴到rpt_sht页面上新创建的图表中 ' create a new chart on the report page Set sh =

我一直在使用宏一次复制多个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,但当我尝试以位图形式复制时,问题仍然存在

当我手动执行相同的操作时,这两种情况都无法发生。实际上,我已经能够修复图纸之间的复制/粘贴问题,但现在该系列在作为位图复制后改变了大小,我很难修复该问题


所以问题是,为什么会发生这种情况,我如何避免它?

我能够通过复制图表并将其粘贴到工作表而不是空白图表来解决工作表之间的问题。不过,您似乎无法粘贴到单元格。对于定位,sheet paste方法有一个destination参数,我用来指定图表左上角的位置

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也起到了作用,因此我猜创建新图表并粘贴到其中一定有点奇怪。

不,不要创建图表,然后将旧图表“粘贴”到新图表中;你可以让各种奇怪的事情发生。不要创建新图表,只需复制旧图表,选择一个单元格,然后粘贴,将图表的副本粘贴到活动单元格中。我可以发誓,这是我以前查找的方式,我讨厌这个答案,但你是对的,它会做奇怪的事情。谢谢你的回答。虽然您的方法并不完全有效(将图表粘贴到单元格会产生错误),但将其粘贴到工作表上并将目标值设置为所需的单元格确实有效得多。谢谢。只需使用
工作表。粘贴
。不要使用仅适用于范围的
Selection.Copy Destination
语法。不能粘贴到单元格中<代码>选择。复制目的地
仅适用于范围<代码>选择。复制
然后是工作表。粘贴复制对象(例如图表或形状),然后粘贴对象,使其左上角覆盖活动单元格。