无需按下播放按钮即可显示颜色值

时间:2017-10-24 00:45:09

标签: excel-vba vba excel

如何在没有点击运行子播放按钮的情况下获得具有相同颜色的Excel工作表中的形状总数,该值将自动显示?

示例:我有3种黄色形状,2种橙色形状和1种蓝色形状,我希望得到的结果为sheet2 Cell(5,3):3(黄色)Cell(5,4): 2(橙色)细胞(5,5):1(蓝色)。但是当vbaproject受密码保护或代码被隐藏时,run sub play按钮将不起作用。

代码如下:

Private Sub Ignore_Click()
    Dim sh As Sheet2
    Dim shp As Shape
    Dim shprange As ShapeRange
    Dim CountyellowShape As Long
    Dim CountorangeShape As Long
    Dim CountblueShape As Long

    Sheet2.Cells(5, 3).Resize().ClearContents
    Sheet2.Cells(5, 4).Resize().ClearContents
    Sheet2.Cells(5, 5).Resize().ClearContents
    Sheet2.Shapes.SelectAll

    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(247, 150, 70) Then CountChildShapeORANGE = CountChildShapeORANGE + 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(247, 150, 70) Then CountShapeORANGE = CountShapeORANGE + 1
        If shp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountShapeBLUE = CountShapeBLUE + 1
    Next shp

    Sheet2.Cells(5, 3) = CountShapeYELLOW + CountChildShapeYELLOW
    Sheet2.Cells(5, 4) = CountShapeORANGE + CountChildShapeORANGE
    Sheet2.Cells(5, 5) = CountShapeBLUE + CountChildShapeBLUE

    End Sub

0 个答案:

没有答案