ooitzechyi
09-20-2016, 12:10 AM
Hi,
I'm facing error when I try to filter grouped shapes by their area.
Error prompt when there is grouped shape in my worksheet, it works perfect when the shape is ungroup.
Private Sub Submit_Click()
Dim xx As Integer
Dim oMyGroup As Shape
Dim shp As Shape
xx = 1
Sheet1.Cells(2, 1).Resize(4).ClearContents
'Sheet1.Shapes.SelectAll
For Each ShapeRange In Sheet1.Shapes
ShapeWidth = ShapeRange.Width / 72
ShapeHeight = ShapeRange.Height / 72
ShapeArea = ShapeWidth * ShapeHeight
If ShapeArea >= TextBox1.Text Then
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
Set shprange = shp.Ungroup
Set oMyGroup = shprange.Group
If shprange.Fill.ForeColor.RGB = RGB(0, 255, 0) Then
CountChildShapeGreen = CountChildShapeGreen + 1
End If
End If
Next shp
If Sheet1.Shapes(xx).Fill.ForeColor.RGB = RGB(0, 255, 0) Then
CountShapeGreen = CountShapeGreen + 1
Sheet1.Cells(2, 1) = CountShapeGreen + CountChildShapeGreen
End If
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
Set shprange = shp.Ungroup
Set oMyGroup = shprange.Group
If shprange.Fill.ForeColor.RGB = RGB(200, 200, 200) Then
CountChildShapeGrey = CountChildShapeGrey + 1
End If
End If
Next shp
If Sheet1.Shapes(xx).Fill.ForeColor.RGB = RGB(200, 200, 200) Then
CountShapeGrey = CountShapeGrey + 1
Sheet1.Cells(3, 1) = CountShapeGrey + CountChildShapeGrey
End If
End If
xx = xx + 1
Next ShapeRange
End Sub
*P/S: The shape could be regular shape or freeform shape.
I'm facing error when I try to filter grouped shapes by their area.
Error prompt when there is grouped shape in my worksheet, it works perfect when the shape is ungroup.
Private Sub Submit_Click()
Dim xx As Integer
Dim oMyGroup As Shape
Dim shp As Shape
xx = 1
Sheet1.Cells(2, 1).Resize(4).ClearContents
'Sheet1.Shapes.SelectAll
For Each ShapeRange In Sheet1.Shapes
ShapeWidth = ShapeRange.Width / 72
ShapeHeight = ShapeRange.Height / 72
ShapeArea = ShapeWidth * ShapeHeight
If ShapeArea >= TextBox1.Text Then
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
Set shprange = shp.Ungroup
Set oMyGroup = shprange.Group
If shprange.Fill.ForeColor.RGB = RGB(0, 255, 0) Then
CountChildShapeGreen = CountChildShapeGreen + 1
End If
End If
Next shp
If Sheet1.Shapes(xx).Fill.ForeColor.RGB = RGB(0, 255, 0) Then
CountShapeGreen = CountShapeGreen + 1
Sheet1.Cells(2, 1) = CountShapeGreen + CountChildShapeGreen
End If
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
Set shprange = shp.Ungroup
Set oMyGroup = shprange.Group
If shprange.Fill.ForeColor.RGB = RGB(200, 200, 200) Then
CountChildShapeGrey = CountChildShapeGrey + 1
End If
End If
Next shp
If Sheet1.Shapes(xx).Fill.ForeColor.RGB = RGB(200, 200, 200) Then
CountShapeGrey = CountShapeGrey + 1
Sheet1.Cells(3, 1) = CountShapeGrey + CountChildShapeGrey
End If
End If
xx = xx + 1
Next ShapeRange
End Sub
*P/S: The shape could be regular shape or freeform shape.