Loop through Charts - Cutting and Pasting As images 1

[tqeonline]

Hello All,

I currently have a spreadsheet that is linking to a lot of data. I have written a partial macro to copy the worksheet and paste just the values (removing linkages).

I think currently have 4 charts that I would like to copy and paste as images which would remove the links to those as well... but my macro doesn't seem to be working as such.

current code:

Sub Create_Summary()
    Macro_Start
    
    'Copy and Paste values on Milestone Dashboard Page
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    'Copy and Paste Charts as Images (removing Links)
    Application.CutCopyMode = False
    
    ActiveSheet.ChartObjects("Chart 7").Activate
    ActiveChart.Paste
    
    ActiveSheet.ChartObjects("Chart 8").Activate
    ActiveChart.Paste
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Paste
    
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.Paste
    
    'Hide the tabs we don't need
    For x = 1 To Sheets.Count
        If Sheets(x).Name <> "Milestone Dashboard" _
            And Sheets(x).Name <> "Milestones Data" _
            And Sheets(x).Name <> "CR Dashboard" Then
                Sheets(x).Delete
        End If
    Next x
    Sheets("Milestone Dashboard").Select
    
    'Save the Spreadsheet as the current location and add "SUMMARY - " to the beginning
    ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\SUMMARY - " & ActiveWorkbook.Name

    Macro_End
End Sub

Macro_Start & Macro_End both are just turning on and off calculation... updating... etc.

Ask: How would i make this scalable to be able to look at X number of charts - copy them, delete them, then paste the picture of the chart.

Reason: This is a roll-up for some executives that I have to do every friday and it gets pulled into another report.

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008

 

[tqeonline]

So i have almost got it:

    'Copy and Paste values on Milestone Dashboard Page
    For i = 1 To ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(i).Select
        ActiveChart.ChartArea.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Selection.Delete
        ActiveChart.Paste
    Next i

This loops through the charts and then pastes it as a picture in the right location.

Issues is the "Selection.Delete" to delete the old chart... it pops up an error.

Thoughts?

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008

 

[SkipVought]

hi,

here's what I would suggest...

    'Copy and Paste values on Milestone Dashboard Page
  with sheets("[b]YourSheetName[/b]")
    For i = 1 To .ChartObjects.Count
        with .ChartObjects(i)
          .ChartArea.CopyPicture Appearance:=xlScreen, Format:=xlPicture
          .Delete
        end with
        sheets("SomeSheet????").PasteSpecial Format:="Picture (PNG)", Link:=False, DisplayAsIcon:=False
    Next i
  end with

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[tqeonline]

Hey Skip!

It errors out on the .ChartArea.CopyPicture

With Sheets("Milestone Dashboard")
        For i = 1 To .ChartObjects.Count
            With .ChartObjects(i)
                .ChartArea.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                .Delete
            End With
            Sheets("Milestone Dashboard").PasteSpecial Format:="Picture (PNG)", Link:=False, DisplayAsIcon:=False
        Next i
    End With

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008

 

[tqeonline]

Actually...

This pastes over the chart -

'Copy and Paste values on Milestone Dashboard Page
    For i = 1 To ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(i).Select
        ActiveChart.ChartArea.Select
        ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        ActiveChart.Paste
    Next i

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008

 

[SkipVought]

this assumes that the PIC gets pasted in the same position as the chart it replaces...

    With Sheets("Milestone Dashboard")
        For i = 1 To .ChartObjects.Count
            With .ChartObjects(i)
                .TopLeftCell.Select
                .CopyPicture Appearance:=xlScreen, Format:=xlPicture
                .Delete
            End With
            Sheets("Milestone Dashboard").PasteSpecial Format:="Picture (PNG)", Link:=False, DisplayAsIcon:=False
        Next i
    End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[tqeonline]

so does yours paste them in the top left cell?

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008

 

[SkipVought]

Your original code DELETES the original chart.

My code does this and pastes the pic in the top left cell of the original chart.

    With Sheets("Milestone Dashboard")
        For i = 1 To .ChartObjects.Count
            With .ChartObjects(i)
                .TopLeftCell.Select
                .CopyPicture Appearance:=xlScreen, Format:=xlPicture
                .Delete
            End With
            .PasteSpecial Format:="Picture (PNG)", Link:=False, DisplayAsIcon:=False
        Next i
    End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[tqeonline]

ahh! That's awesome.

I needed both

- Matt

"If I must boast, I will boast of the things that show my weakness"

- Windows 2003 Server, 98 SE, XP
- VB.NET, VSTS 2010, ASP.NET, EXCEL VBA, ACCESS, SQL 2008