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

Question

I have been using macros to copy multiple Excel charts at once so I can manually paste them into OneNote as part of a reporting process. However, after switching to Office 365 everything has been acting very strange.

I start by creating all of these charts on their respective sheets and then I have a macro that consolidates all of the charts onto one sheet. This macro creates a new sheet (rpt_sht) and for each chart I want to copy over, it creates a new chart on the rpt_sht page, copies the the original chart and pastes it into the newly created chart on the rpt_sht page.

' 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

I then have a few buttons on the rpt_sht page that allow me to group, copy as bitmap, and ungroup different combinations of these charts.

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

There are a two problems that arise:

1) When copying the charts between sheets, the chart legend changes from using the data series names to using Series 1, Series 2, etc... I was able to fix this by saving the names in a collection before copying and then renaming everything after pasting, but I feel like that shouldn't happen.

2) When I copy between sheets or as a bitmap, the marker sizes randomly change for only some of the series. I set them all to 3 after pasting in the rpt_sht, but the problem continues when I try to copy as bitmap.

I can't get either of these things to happen when I do the same operations manually. Really I have been able to fix the copying/pasting between sheets, but now the series change size after copying as bitmap and I am having a harder time to fix that issue.

So the question is, why is this happening and how can I avoid it?

Answer 1

I was able to fix the sheet-to-sheet issue by copying the chart and pasting it to the sheet instead of a blank chart. You can't seem to paste to a cell though. For positioning, the sheet paste method has a destination argument that I used to specify the position of the top left corner of the chart.

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

After doing this, copying to OneNote has worked as well, so I guess it must have been something weird with creating a new chart and pasting into it.