N
Nigel RS
Hi All
I have an Application (appWB) that has a sheet with 12 embedded charts, the
following code is used to copy each chart to another workbook (myWB) which
has already been set up with a sheet named Charts.
This process is extremly slow and I suspect it is due to activating and
selecting a range on myWB.Sheets("Charts"). I do not seem to be able to
avoid these steps. Ideally I would rather carry out the task as copy and
paste (as picture) directly.
Each chart has to be selected in turn as I require a picture for each, not
one bigger picture if I were to select ALL charts and copy them across as a
collection.
Any ideas?
'================
' copy the charts
Dim myCh As ChartObject
Dim rX As Integer, cX As Integer
With appWB.Sheets("Charts")
' copy chart objects as images
' start row and column for destination of chart
rX = 5: cX = 1
' process each chart (1 to 12)
For Each myCh In .ChartObjects
myCh.Copy
With myWB.Sheets("Charts")
.Activate
.Cells(rX, cX).Select
.PasteSpecial Format:="Picture (Enhanced Metafile)"
End With
' increment output row for next chart
rX = rX + 13
' test if needs to be in new column
If rX > 70 Then
rX = 5: cX = 6
End If
Next
End With
'=====================
I have an Application (appWB) that has a sheet with 12 embedded charts, the
following code is used to copy each chart to another workbook (myWB) which
has already been set up with a sheet named Charts.
This process is extremly slow and I suspect it is due to activating and
selecting a range on myWB.Sheets("Charts"). I do not seem to be able to
avoid these steps. Ideally I would rather carry out the task as copy and
paste (as picture) directly.
Each chart has to be selected in turn as I require a picture for each, not
one bigger picture if I were to select ALL charts and copy them across as a
collection.
Any ideas?
'================
' copy the charts
Dim myCh As ChartObject
Dim rX As Integer, cX As Integer
With appWB.Sheets("Charts")
' copy chart objects as images
' start row and column for destination of chart
rX = 5: cX = 1
' process each chart (1 to 12)
For Each myCh In .ChartObjects
myCh.Copy
With myWB.Sheets("Charts")
.Activate
.Cells(rX, cX).Select
.PasteSpecial Format:="Picture (Enhanced Metafile)"
End With
' increment output row for next chart
rX = rX + 13
' test if needs to be in new column
If rX > 70 Then
rX = 5: cX = 6
End If
Next
End With
'=====================