Thanks Joel

The macro now works fine (no non chart shapes on the page to worry about)

Can you point me in the right direction to modify the code for 6 charts (3
across, 2 down)
I assume the array needs to be changed as well as the swap order but I'm
getting a little confused.

thanks
Graham

"Joel" wrote:

I originally tested the code using pictures instead of charts on my PC at
home and everything worked. At work I got the same error that you did.
found by putting Activesheet before Sheets removed the error. Not sure why.

I also added a message box to indicate number of shapes being moved. There
are other objects you may have on you wroksheet that will be considered
shaped. Want to find out if I have to filter the code to look at only charts.


Sub movecharts()

Dim MyShapes()

NumShapes = ActiveSheet.Shapes.Count
msgbox("Moving " & NumShapes & " Shapes")
ReDim MyShapes(0 To NumShapes - 1, 0 To 2)
Shapecount = 0
For Each Shp In ActiveSheet.Shapes
MyShapes(Shapecount, 0) = Shp.Top
MyShapes(Shapecount, 1) = Shp.Left
MyShapes(Shapecount, 2) = Shp.Name

Shapecount = Shapecount + 1
Next Shp

'sort so order is
' 0 = top left
' 1 = top right
' 2 = bottom left
' 3 = bottom right

'code below was written so it would be easily
'modified for more chart

'bubble sort by top parameter
For i = 0 To (NumShapes - 2)
For j = (i + 1) To (NumShapes - 1)
If MyShapes(j, 0) < MyShapes(i, 0) Then
'swap shapes in array
For k = 0 To 2
Temp = MyShapes(i, k)
MyShapes(i, k) = MyShapes(j, k)
MyShapes(j, k) = Temp
Next k
End If

Next j
Next i

'Repeat for number of rows
For h = 1 To 2
'bubble sort by left parameter
For i = 0 To 2 Step 2
For j = (i + 1) To (i + 1)
If MyShapes(j, 1) < MyShapes(i, 1) Then
'swap shapes in array
For k = 0 To 2
Temp = MyShapes(i, k)
MyShapes(i, k) = MyShapes(j, k)
MyShapes(j, k) = Temp
Next k
End If
Next j
Next i
Next h

'now move charts
' put chart 1 in chart 0 psoition and etc
Set FirstShape = ActiveSheet.Shapes(MyShapes(0, 2))
FirstShape.Delete
For Shapecount = 0 To (NumShapes - 2)
Set NextShape = ActiveSheet.Shapes(MyShapes(Shapecount + 1, 2))
With NextShape
.Top = MyShapes(Shapecount, 0)
.Left = MyShapes(Shapecount, 1)
End With
Next Shapecount

End Sub


"Graham" wrote:

Thanks for the reply.

Had a good look through and think I understand.

Unfortunately the code errors (object required) at
NumShapes = Shapes.Count
Does this need to be declared?


"Joel" wrote:

Interesting problem!!! Since the charts are not in any order on the sheet
you first have to sort the charts according to there position. I made the
code general incase it need to be expanded for my charts.

I assumed the order of the charts where from left to right, and then up to
down. I also assumed yo want to put the charts in the exact same postion the
when you are done. I also used shapes as the object since charts are shapes.
there may be a problem if there are other object on the sheet. I found the
positions of all the shapes in an array including the shape name, left, and
top position. the performed two sorts to get the array in the correct order.
See code below.


Sub movecharts()

Dim MyShapes()

NumShapes = Shapes.Count
ReDim MyShapes(0 To NumShapes - 1, 0 To 2)
Shapecount = 0
For Each Shape In Shapes
MyShapes(Shapecount, 0) = Shape.Top
MyShapes(Shapecount, 1) = Shape.Left
MyShapes(Shapecount, 2) = Shape.Name

Shapecount = Shapecount + 1
Next Shape

'sort so order is
' 0 = top left
' 1 = top right
' 2 = bottom left
' 3 = bottom right

'code below was written so it would be easily
'modified for more chart

'bubble sort by top parameter
For i = 0 To (NumShapes - 2)
For j = (i + 1) To (NumShapes - 1)
If MyShapes(j, 0) < MyShapes(i, 0) Then
'swap shapes in array
For k = 0 To 2
Temp = MyShapes(i, k)
MyShapes(i, k) = MyShapes(j, k)
MyShapes(j, k) = Temp
Next k
End If

Next j
Next i

'Repeat for number of rows
For h = 1 To 2
'bubble sort by left parameter
For i = 0 To 2 Step 2
For j = (i + 1) To (i + 1)
If MyShapes(j, 1) < MyShapes(i, 1) Then
'swap shapes in array
For k = 0 To 2
Temp = MyShapes(i, k)
MyShapes(i, k) = MyShapes(j, k)
MyShapes(j, k) = Temp
Next k
End If
Next j
Next i
Next h

'now move charts
' put chart 1 in chart 0 psoition and etc
Set FirstShape = Shapes(MyShapes(0, 2))
FirstShape.Delete
For Shapecount = 0 To (NumShapes - 2)
Set NextShape = Shapes(MyShapes(Shapecount + 1, 2))
With NextShape
.Top = MyShapes(Shapecount, 0)
.Left = MyShapes(Shapecount, 1)
End With
Next Shapecount

End Sub


"Graham" wrote:

Hi

I am trying to automate a particularly mundane task.

I have a running 6 months of charts on each page repeated for 15 different
criteria.
Currenlty I have to delete the oldest and reposition the remainder to free
up space for the latest month's chart.

I have recorded a macro which reflects this task but obviously needs to be
modified as it selects specific charts.

Can the following code be amended to select charts by their position on the
page?

ActiveSheet.ChartObjects("Chart 21").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Chart 44").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Windows("Copy of Insurer MI Report v1.06.xls").Activate
ActiveSheet.Shapes.Range(Array("Chart 44", "Chart 61")).Select
Selection.ShapeRange.IncrementLeft -336#
ActiveSheet.ChartObjects("Chart 76").Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 76").IncrementLeft 670.5
ActiveSheet.Shapes("Chart 76").IncrementTop -331.5

Any suggestions would be very much appreciated