Cut & Paste Graph as Picture

[Andrewdm]

I have a sheet with a number of graphs on it. Using a macro, I would like to CUT all the graphs and PASTE them as pictures (ie so that there are no longer any graph objects on the sheet). Also, how do you make sure that the graphs are pasted back into their original position? At the moment, they get pasted into the area surrounding the active cell.

 

[Andrew Poulsom]

Try this:

Sub Test()
    Dim ChObj As ChartObject
    Dim Top As Double
    Dim Left As Double
    Application.ScreenUpdating = False
    For Each ChObj In ActiveSheet.ChartObjects
        Top = ChObj.Top
        Left = ChObj.Left
        ChObj.Cut
        ActiveSheet.Pictures.Paste.Select
        Selection.Top = Top
        Selection.Left = Left
    Next ChObj
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[Andrewdm]

Thanks. It does the job, but is really slow. anyway to make it quicker as the macro has to run on a total 2800 sheets each containing 5 graphs.

 

[Andrew Poulsom]

I would expect it to take some time to deal with that number of charts.

What is you purpose in converting them to pictures?

 

[Andrewdm]

Hi. Ignore last reply. It's not slow, I was having a problem with my computer.

Is there away to specify that it must only cut & paste graphs that are contained in the range ("A1:J45) ?

 

[Andrewdm]

A number of computers here can't seem to open graphs that have been created in Excel XP (they are using Office 97). The only way we got around the problem is to cut and paste the graphs as a picture. They can now open all the files.

Another question - how can you delete the sheet containing the graphs data, but without the actual graph changing?

 

[Andrew Poulsom]

Two questions:

1. You mean where the top left of the chart is in the range A1:J45?
2. You mean convert the series data to values?

 

[Andrewdm]

I have 5 graphs within the range A1:J45 and another 5 graphs outside of that range. I only want to cut and paste the graphs in the range A1:J45.

 

[Andrew Poulsom]

This seems to work:

Sub Test()
    Dim TestRange As Range
    Dim ChObj As ChartObject
    Dim ChRange As Range
    Dim Top As Double
    Dim Left As Double
    Application.ScreenUpdating = False
    Set TestRange = Range("A1:J45")
    For Each ChObj In ActiveSheet.ChartObjects
        Set ChRange = ChObj.TopLeftCell
        If Not Intersect(TestRange, ChRange) Is Nothing Then
            Top = ChObj.Top
            Left = ChObj.Left
            ChObj.Cut
            ActiveSheet.Pictures.Paste.Select
            Selection.Top = Top
            Selection.Left = Left
        End If
    Next ChObj
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

It does not answer your question "how can you delete the sheet containing the graphs data, but without the actual graph changing?".