Hallo zusammen
ich habe folgendes Problem. Ich muss drei vierecke auf einem Sheet erstellen welche gruppiert sind (s. Code) und an der aktuellen Zellposition eingefügt werden sollen. Das funktioniert auch so weit. Mein Problem ist wie kann ich diese Elemente gruppiert verschieben an den Zielort.
Danke für eure Hilfe
Daniel
Sourcecode:
Sub GrafikInsertActiveCell()
Dim shp As Shape
Dim GrafikName(0 To 3) As String
Dim i As Integer
Application.ScreenUpdating = False

'* Erstellen des ersten Rechtecks
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 120, 40)
With shp
.Fill.ForeColor.SchemeColor = 26
.Line.Weight = 2
End With

s = shp.Name
GrafikName(i) = s
i = i + 1

'* Erstellen des zweiten Rechtecks
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 60, 20)
With shp
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With

s = shp.Name
GrafikName(i) = s
i = i + 1

'* Erstellen des dritten Rechtecks
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 40, 60, 20)
With shp
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 0
End With

s = shp.Name
GrafikName(i) = s

'* Gruppieren der erstellten Zeichnungselemente
?????????????????????????????????????????????????????????????
ActiveSheet.Shapes.Range(Array(GrafikName(0), GrafikName(1), GrafikName(2))).Select

Set shp = ActiveSheet.Shapes(GrafikName(x))
shp.Top = ActiveCell.Top
shp.Left = ActiveCell.Left

Application.ScreenUpdating = True

Range("A1").Select
End Sub