ooitzechyi
09-08-2016, 11:33 PM
Hi,
I'm new with VB. Pls bare with me.
I using VB excel and trying to get the number of shapes with same color but I'm stuck.
I had assigned a macro to insert shape with fixed color selection (where there will be more than 100+ of shapes with some fixed colors in my excel sheet),
and I need to get the summary of total of shapes with same color. For example,
I have 3 red shapes, 3 green shapes and 2 yellow shapes, I wish to get the result as
Cell (2,1): 3 (Red)
Cell (3,1): 3 (Green)
Cell (4,1): 2 (Yellow)
'Code to get the shape
Private Sub Green_Click()
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 70, 206, _
172, 91).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = vbGreen
.BackColor.RGB = vbGreen
.ForeColor.Brightness = 0.8
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = vbGreen
.ForeColor.Brightness = 0.8
.Transparency = 0
End With
With SelectShapeColor
Unload Me
End With
End Sub
'Code for Calc Number of Shape
Sub CalcShape()
Dim sh As Sheet1
Dim shp As Shape
Dim vbYellow As Single
Dim vbGrey As Single
Dim vbRed As Single
Dim vbGreen As Single
Dim CountRedShape As Integer
For Each shp In Sheet1.Shapes
CountRedShape = 0
If shp.Fill.ForeColor.RGB = vbRed And shp.Fill.ForeColor.Brightness = 0.8 Then
ActiveSheet1.Cells(2, 1) = CountRedShape + 1
End If
Next
End Sub
There is no error shows but no result as well.
I'm not sure where goes wrong.
Pls helps~
Thanks
I'm new with VB. Pls bare with me.
I using VB excel and trying to get the number of shapes with same color but I'm stuck.
I had assigned a macro to insert shape with fixed color selection (where there will be more than 100+ of shapes with some fixed colors in my excel sheet),
and I need to get the summary of total of shapes with same color. For example,
I have 3 red shapes, 3 green shapes and 2 yellow shapes, I wish to get the result as
Cell (2,1): 3 (Red)
Cell (3,1): 3 (Green)
Cell (4,1): 2 (Yellow)
'Code to get the shape
Private Sub Green_Click()
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 70, 206, _
172, 91).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = vbGreen
.BackColor.RGB = vbGreen
.ForeColor.Brightness = 0.8
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = vbGreen
.ForeColor.Brightness = 0.8
.Transparency = 0
End With
With SelectShapeColor
Unload Me
End With
End Sub
'Code for Calc Number of Shape
Sub CalcShape()
Dim sh As Sheet1
Dim shp As Shape
Dim vbYellow As Single
Dim vbGrey As Single
Dim vbRed As Single
Dim vbGreen As Single
Dim CountRedShape As Integer
For Each shp In Sheet1.Shapes
CountRedShape = 0
If shp.Fill.ForeColor.RGB = vbRed And shp.Fill.ForeColor.Brightness = 0.8 Then
ActiveSheet1.Cells(2, 1) = CountRedShape + 1
End If
Next
End Sub
There is no error shows but no result as well.
I'm not sure where goes wrong.
Pls helps~
Thanks