饼图基于单元格颜色

时间:2014-05-02 00:25:04

标签: excel vba

我正在尝试制作一个饼图,它显示与单元格相同的颜色,并以单元格文本作为标签。

它显示为条形图。

我的Excel文件https://drive.google.com/file/d/0B1GLuBx-ROnhVUFoQTlMU2RqWGs/edit?usp=sharing

Sub ColorBreakdown()

Dim rCell As Range
Dim lRedCount As Long, lGreenCount As Long, lYellowCount As Long

    For Each rCell In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Select Case rCell.Interior.Color
            Case RGB(230, 184, 183)
                lRedCount = lRedCount + 1
            Case RGB(216, 228, 188)
                lGreenCount = lGreenCount + 1
            Case RGB(255, 255, 153)
                lYellowCount = lYellowCount + 1
        End Select
    Next rCell

    With ActiveSheet.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
    With .Chart
        .SeriesCollection.NewSeries.Values = Array(lRedCount, _
            lGreenCount, lYellowCount)
        With .SeriesCollection(1)
            .Points(1).Interior.Color = RGB(230, 184, 183)
            .Points(3).Interior.Color = RGB(216, 228, 188)
            .Points(5).Interior.Color = RGB(255, 255, 153)
        End With
        .ChartType = xlPie
        .HasLegend = False
    End With
End With

End Sub

1 个答案:

答案 0 :(得分:1)

试试这个。我使用标准的R,G,B颜色以便于测试。

尝试并经过测试:

Dim rCell As Range
Dim lRedCount As Long, lGreenCount As Long, lBlueCount As Long
Dim ws As Worksheet
Dim SChrt As Shape
Set ws = ActiveSheet

    For Each rCell In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Select Case rCell.Interior.Color
            Case RGB(255, 0, 0)
                lRedCount = lRedCount + 1
            Case RGB(0, 255, 0)
                lGreenCount = lGreenCount + 1
            Case RGB(0, 0, 255)
                lBlueCount = lBlueCount + 1
        End Select
    Next rCell

    'Debug.Print lRedCount, lGreenCount, lBlueCount

    Set SChrt = ws.Shapes.AddChart(xlPie, 100, 375, 75, 225)
    With SChrt.Chart
         .SeriesCollection.NewSeries.Values = Array(lRedCount, _
            lGreenCount, lBlueCount)
        With .SeriesCollection(1)
            .Points(1).Interior.Color = RGB(255, 0, 0)
            .Points(2).Interior.Color = RGB(0, 255, 0)
            .Points(3).Interior.Color = RGB(0, 0, 255)
        End With
    End With

我对您的代码进行了小幅修改 一种是将ws变量声明为WorkSheetSChrt变为Shape。 原因是Intellisense启动。不知何故,它没有使用ActiveSheet显示 其次是使用Shape代替ChartObjects 基本上我们在Chart集合下添加了Shape 触发Intellisense后,可以轻松设置参数 其余部分与您的代码相同,但颜色略有不同 希望这会有所帮助。