PDA

View Full Version : [SOLVED] Group shapes in a single cell without select



sifar786
04-29-2016, 08:09 AM
I have multiple charts and some arrow shapes (linking to certain cells on Sheet2 to show the cell's value), all placed together inside the boundaries of a single merged cell E5.

this code works when i add different shapes and even charts to the cell and then try to run the code to group them together. However i assume it doesn't seem to work for charts which reference ranges from a pivot...i may be wrong here, and it could be totally something.



Option Explicit

Sub doit()
Call GroupShapes(Sheet2.Cells(5, "E"))
End Sub

Sub GroupShapes(rngChart As Range)
Dim Shp As Shape
Dim ShpRng As ShapeRange
Dim ShpGrp As Variant
Dim Arr() As Variant
Dim i As Long

i = 1
With rngChart.Parent
For Each Shp In .Shapes
If Shp.TopLeftCell.MergeArea.Row = rngChart.MergeArea.Row Then
ReDim Preserve Arr(1 To i)
Arr(i) = Shp.Name
i = i + 1
End If
Next Shp

Set ShpRng = .Shapes.Range(Arr)

//Here i get -> 'Application defined or Object defined error'
Set ShpGrp = ShpRng.Group

With ShpGrp
.Name = "shp" & VBA.Replace(rngChart.Parent.Name, " ", "")
End With
End With
End Sub


If i select all the shapes and then try to group them manually or via code (as shown below), it does Group. What am i doing wrong?


Sub doit1()
Dim rngChart As Range

Sheet2.Activate
With Sheet2
Set rngChart = .Cells(5, "E")
End With
Call GroupShapes1(rngChart)

End Sub

Sub GroupShapes1(rngChart As Range)
Dim Shp As Variant
Dim Arr() As Variant

With rngChart.Parent
For Each Shp In .Shapes
If Not Intersect(.Range(Shp.TopLeftCell.MergeArea.Cells, Shp.BottomRightCell.MergeArea.Cells), rngChart) Is Nothing Then
Shp.Select Replace:=False
End If
Next Shp
Set Shp = Selection.Group
End With
End Sub


I want to group the shapes without selecting them. If anyone has any idea why this is happening, kindly assist.

sifar786
05-02-2016, 06:29 AM
I found that the reason the charts were not getting selected was because each chart was named the same I.e. Object13, though their ID's were different. So once I renamed each shape and chart with a unique name ( here ID would just suffice), the grouping was possible.



Option Explicit

Sub doit()
Call GroupShapes(Sheet2.Cells(5, "E"))
End Sub

Sub GroupShapes(rngChart As Range)
Dim Shp As Shape
Dim ShpRng As ShapeRange
Dim ShpGrp As Variant
Dim Arr() As Variant
Dim i As Long i = 1

With rngChart.Parent
For Each Shp In .Shapes
If Shp.TopLeftCell.MergeArea.Row = rngChart.MergeArea.Row Then
With Shp
.Name = .Type & .ID
End With

ReDim Preserve Arr(1 To i)
Arr(i) = Shp.Name
i = i + 1
End If
Next Shp

Set ShpRng = .Shapes.Range(Arr)
Set ShpGrp = ShpRng.Group

With ShpGrp
.Name = "shp" & VBA.Replace(rngChart.Parent.Name, " ", "")
End With
End With
End Sub