Greetings,
I have 4 shapes in one group in Excel Workbook, I want is when I color 2 shapes in yellow, Cells(6, 21) will appear 1 and cells(6, 22) will appear 2, and the other 2 shapes I color in blue, cells(9, 21) still remain 0 and Cells(9, 22) are 2.
Below is my vba code I apply in my workbook but did not work as I want.
Thanking in advance.
Wiz Lee
I have 4 shapes in one group in Excel Workbook, I want is when I color 2 shapes in yellow, Cells(6, 21) will appear 1 and cells(6, 22) will appear 2, and the other 2 shapes I color in blue, cells(9, 21) still remain 0 and Cells(9, 22) are 2.
Below is my vba code I apply in my workbook but did not work as I want.
Code:
Private Sub Worksheet_Activate() Dim shp As Shape
Dim shprange As ShapeRange
Dim CountyellowShape As Long
Dim CountorangeShape As Long
Dim CountpinkShape As Long
Dim CountblueShape As Long
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(255, 255, 0) Then CountChildShapeYELLOW = CountChildShapeYELLOW + 1
If shprange.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountChildShapeORANGE = CountChildShapeORANGE + 1
If shprange.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountChildShapePINK = CountChildShapePINK + 1
If shprange.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountChildShapeBLUE = CountChildShapeBLUE + 1
End If
Next shp
For Each shp In Sheet1.Shapes
If shp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountShapeYELLOW = CountShapeYELLOW + 1
If shp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountShapeORANGE = CountShapeORANGE + 1
If shp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountShapePINK = CountShapePINK + 1
If shp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountShapeBLUE = CountShapeBLUE + 1
Next shp
Sheet1.Cells(6, 21) = CountShapeYELLOW + CountChildShapeYELLOW
Sheet1.Cells(7, 21) = CountShapeORANGE + CountChildShapeORANGE
Sheet1.Cells(8, 21) = CountShapePINK + CountChildShapePINK
Sheet1.Cells(9, 21) = CountShapeBLUE + CountChildShapeBLUE
For Each shp In Sheet1.Shapes
If shp.Type = msoGroup Then
Set shprange = shp.Ungroup
For Each grpShp In shprange
If grpShp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountChildShapeYELLOW = CountChildShapeYELLOW + 1
If grpShp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountChildShapeORANGE = CountChildShapeORANGE + 1
If grpShp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountChildShapePINK = CountChildShapePINK + 1
If grpShp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountChildShapeBLUE = CountChildShapeBLUE + 1
Next grpShp
shprange.Group
Else
If shp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountShapeYELLOW = CountShapeYELLOW + 1
If shp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountShapeORANGE = CountShapeORANGE + 1
If shp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountShapePINK = CountShapePINK + 1
If shp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountShapeBLUE = CountShapeBLUE + 1
End If
Next shp
Sheet1.Cells(6, 22) = CountShapeYELLOW + CountChildShapeYELLOW
Sheet1.Cells(7, 22) = CountShapeORANGE + CountChildShapeORANGE
Sheet1.Cells(8, 22) = CountShapePINK + CountChildShapePINK
Sheet1.Cells(9, 22) = CountShapeBLUE + CountChildShapeBLUE
End Sub
Thanking in advance.
Wiz Lee
Last edited: