Copy and pasting a line into a chart using VBA - excel

Question

First time using this site. Borrowing an idea from the SpreadSheetGuru, I am copy and pasting bunch of drawn shapes into a temporary chart such that I can save them as a PNG image. I copy and paste different shapes, one by one, and then move them using Top and Left properties so they look like the original arrangement. It works great for rectangles and textboxes but gives me an error for lines (straight connectors). It says “the item with specified name wasn’t found” but I do not use anything different. I appreciate your help to solve this problem. Here is that part of the code below. The lines are copied and pasted, as I can see them when I step through the code, but cannot be "addressed" to be moved to their correct location on the chart
k = 0
For Each sh In ActiveSheet.Shapes ' ---------------------------------------- select one shape at a time
a1 = InStr(1, Trim(sh.Name), "TextBox", 1)
A2 = InStr(1, Trim(sh.Name), "Rectangle", 1)
a3 = InStr(1, Trim(sh.Name), "Straight", 1)
a4 = InStr(1, Trim(sh.Name), "Line", 1)
If a1 > 0 Or A2 > 0 Or a3 > 0 Or a4 > 0 Then
sh.Select
k = k + 1
Else: GoTo NextShape:
End If
sh.Name = sh.Name & k
'Copy/Paste Shape inside temporary chart
ActiveShape.Copy
cht.Activate
ActiveChart.Paste
ActiveChart.Shapes(UserSelection.Name).Top = ActiveShape.Top - Top0 ' === ERROR IS HERE
ActiveChart.Shapes(UserSelection.Name).Left = ActiveShape.Left - Left0
NextShape:
Next sh ' ----------------------------------------------------------------------

Answer 1

Here's a couple of different approaches. Both are pasting the shapes into a chart inserted on the worksheet (ie. I'm not using a chart sheet)
Sub CopyShapesToChart()
Dim sh, cht As Chart, e, shp, col As New Collection
Dim minY, minX, maxY, maxX, v
Set cht = ActiveSheet.ChartObjects(1).Chart
minY = 1000000# 'set starting points (random high number)
minX = 1000000#
'First collect all of the shapes we're interested in,
' and figure out the "bounding box" for them
For Each shp In ActiveSheet.Shapes
For Each e In Array("TextBox", "Rectangle", "Straight", "Line")
If InStr(1, shp.Name, e) > 0 Then
'tracking bounding box for all shapes
If shp.Top < minY Then minY = shp.Top
If shp.Left < minX Then minX = shp.Left
v = shp.Top + shp.Height
If v > maxY Then maxY = v
v = shp.Left + shp.Width
If v > maxX Then maxX = v
col.Add shp
Exit For
End If
Next e
Next shp
'resize the chartobject to fit the collection of shapes
cht.Parent.Height = maxY - minY
cht.Parent.Width = maxX - minX
'copy each shape into the chart
For Each shp In col
shp.Copy
cht.Paste
With cht.Shapes(cht.Shapes.Count)
.Top = shp.Top - minY
.Left = shp.Left - minX
End With
Next shp
'now export the chart...
End Sub
EDIT: a second approach with a little less work - instead of copying shapes one-by-one group all of them and copy them in one operation
Sub CopyShapesToChart2()
Dim sh, cht As Chart, e, shp
Dim arr(), ws As Worksheet, i As Long, rng
Set ws = ActiveSheet
Set cht = ws.ChartObjects(1).Chart
ReDim arr(0 To ws.Shapes.Count)
For Each shp In ws.Shapes
For Each e In Array("TextBox", "Rectangle", "Straight", "Line")
If InStr(1, shp.Name, e) > 0 Then
arr(i) = shp.Name
i = i + 1
Exit For
End If
Next e
Next shp
If i > 0 Then 'matched any shapes?
If i > 1 Then 'matched>1 shape?
ReDim Preserve arr(0 To i - 1)
Set rng = ws.Shapes.Range(arr).Group() 'group the matched shapes
Else
Set rng = ws.Shapes(arr(0)) 'just matched a single shape
End If
'resize the chartobject to fit the [collection of] shape[s]
cht.Parent.Height = rng.Height
cht.Parent.Width = rng.Width
rng.Copy 'copy the shape or group
cht.Paste
If i > 1 Then rng.Ungroup 'ungroup if we grouped anything
End If
End Sub

Answer 2

A friend of mine (Ray Hayes) provided the answer off line. To make the original code work, all is needed is to change "UserSelection.Name" to "Selection.Name".