Paste Chart Image as new worksheet

[gdesreu]

I was hoping someone has an answer for this.

I have a chart that I want to copy and paste as an image on a new worksheet. The excerpt (bottom) works fine except that I want to paste it as a new worksheet NOT on top of a new worksheet. You can do this when moving a chart as new worksheet using

ActiveChart.Location Where:=xlLocationAsNewSheet

but I'm a bit confused as to how to copy the chart as an image and then insert it as a new worksheet.

Any help (as always) is greatly appreciated.

Working Code that pastes as image onto new worksheet.

    Selection.Copy
    Sheets("example").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveChart.ChartArea.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Pictures.Paste.Select

 

[Domenic]

I'm assuming that the reason you want to paste your chart as a picture is so that there's no link between the newly created chart sheet and the original chart. If so, try the following macro, which will copy the chart from the active sheet, create a new chart sheet, paste the chart into the newly created chart sheet, and then convert the formulas into values...

Option Explicit

Sub test()

    ActiveSheet.ChartObjects("Chart 3").Chart.ChartArea.Copy
   
    DoEvents

    Dim chartSheet As Object
    Set chartSheet = ThisWorkbook.Charts.Add
   
    DoEvents
   
    With chartSheet
   
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
       
        .Paste
       
        DoEvents
   
        With .SeriesCollection(1)
            .XValues = .XValues
        End With
   
        Dim sr As Series
        For Each sr In .SeriesCollection
            sr.Name = "=""" & sr.Name & """"
            sr.Values = sr.Values
        Next sr
       
    End With
   
End Sub

Hope this helps!

 

[gdesreu]

I'm assuming that the reason you want to paste your chart as a picture is so that there's no link between the newly created chart sheet and the original chart. If so, try the following macro, which will copy the chart from the active sheet, create a new chart sheet, paste the chart into the newly created chart sheet, and then convert the formulas into values...

Option Explicit

Sub test()

    ActiveSheet.ChartObjects("Chart 3").Chart.ChartArea.Copy
  
    DoEvents

    Dim chartSheet As Object
    Set chartSheet = ThisWorkbook.Charts.Add
  
    DoEvents
  
    With chartSheet
  
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
      
        .Paste
      
        DoEvents
  
        With .SeriesCollection(1)
            .XValues = .XValues
        End With
  
        Dim sr As Series
        For Each sr In .SeriesCollection
            sr.Name = "=""" & sr.Name & """"
            sr.Values = sr.Values
        Next sr
      
    End With
  
End Sub

Hope this helps!

This is exactly what I was looking for! I cant thank you enough. Much appreciated!

 

[Domenic]

You're very welcome, I'm glad I could help.

Cheers!

 

[gdesreu]

You're very welcome, I'm glad I could help.

Cheers!

Domenic, one more thing I just noticed, (sorry I didnt pick this up earlier) Is there a way to set the objects on the chart to a value as well like you did with the series? I have the chart title linked to a cell which loops through different samples so when I look at it now it still has the cell reference and not the value. Again, thanks, this is super helpful.

 

[gdesreu]

Also, if I try to run the code twice, for example if I make a second histogram it deletes everything on the second chart but the first one seems ok. - Thanks

 

[Domenic]

I have amended my macro so that it converts the formula for the chart title into a value. Also, notice that have declared chartSheet as Chart instead of Object.

Option Explicit

Sub test()

    ActiveSheet.ChartObjects("Chart 3").Chart.ChartArea.Copy
    
    DoEvents

    Dim chartSheet As Chart
    Set chartSheet = ThisWorkbook.Charts.Add
    
    DoEvents
    
    With chartSheet
    
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
        
        .Paste
        
        DoEvents
        
        If .HasTitle Then
            .ChartTitle.Caption = .ChartTitle.Caption
        End If
    
        With .SeriesCollection(1)
            .XValues = .XValues
        End With
    
        Dim sr As Series
        For Each sr In .SeriesCollection
            sr.Name = "=""" & sr.Name & """"
            sr.Values = sr.Values
        Next sr
        
    End With
    
End Sub

 

[Domenic]

Also, if I try to run the code twice, for example if I make a second histogram it deletes everything on the second chart but the first one seems ok. - Thanks

Can you please clarify?

 

[Domenic]

I think I know what you mean. It's probably a timing issue. I'll post an amended version of my macro shortly.

 

[Domenic]

Okay, I have amended the code so that it pauses at certain times to allow the operation time to complete. Currently, when it pauses, it does so for 1 second, which should be enough time. However, if you still run into problems, you can always try pausing it for more seconds, such as 2 or 3 seconds. Here's the amended code, which includes an additional procedure called Pause.

Option Explicit

Sub test()

    ActiveSheet.ChartObjects("Chart 3").Chart.ChartArea.Copy
    
    Pause 1 'second

    Dim chartSheet As Chart
    Set chartSheet = ThisWorkbook.Charts.Add
    
    Pause 1 'second
    
    With chartSheet
    
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
        
        .Paste
        
        Pause 1 'second
        
        If .HasTitle Then
            .ChartTitle.Caption = .ChartTitle.Caption
        End If
    
        With .SeriesCollection(1)
            .XValues = .XValues
        End With
    
        Dim sr As Series
        For Each sr In .SeriesCollection
            sr.Name = "=""" & sr.Name & """"
            sr.Values = sr.Values
        Next sr
        
    End With
    
End Sub

Sub Pause(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer + secs
    
    Do
        DoEvents
    Loop Until Timer > endTime
    
End Sub

Does this help?