Pictures in an Excel spreadsheet

[NewbyOld]

Hi,

I am trying to write a macro that will take a set of excel charts and then copy them as pictures into another spreadsheet. The graphs will be updated every month and the most recent version should replace the old version. The problem is that pictures seem to be numbered dynamically in Excel. For example if you cut and then paste back a picture it will have a different number than before eg Picture 339 will become Picture 341 when pasted back. My macro fails because when it tries to delete the old picture it fails to find it and I end up with one picture on top of another. I have tried using the Shapes collection to no avail, the same thing happens.

 

[SkipVought]

Hi,

Check out the CopyPicture method.

Post your code if you have problems.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[NewbyOld]

Here is the code for a macro that deletes one picture and inserts a new one. I have many pictures to update but you will get the idea from the code.

Sub Macro2()
Worksheets("Sickness Absence").Activate
Range("N12").Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
xlPicture
ActiveWindow.Visible = False
Windows("Performance Report - January 2009 - with actions 2.xls").Activate
ActiveSheet.Shapes(32).Select
Selection.Delete
Range("B3:B19").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.56, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.04, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.01, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 0.98, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 0.98, msoFalse, msoScaleFromBottomRight
End Sub

The problem is that when I run the macro to copy the new picture in it will no longer be Shapes(32) because the pictures do not have a fixed id. The next time I run the macro it fails on

ActiveSheet.Shapes(32).Select
Selection.Delete

it either says object not found or worse still it will delete the shape that is currently Shape(32) !!

 

[SkipVought]

With ActiveSheet
   .Shapes(.Shapes.Count).Delete
End With

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}