基于单元格颜色的饼图

Question

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

它显示为条形图。

我的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 

Answer 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 

我对你的代码做了细微的修改。
一个是将和SChrt的变量ws作为Shape加入变量。
原因是为Intellisense踢。不知何故，它不显示使用ActiveSheet。
其次是使用Shape而不是ChartObjects。
基本上我们在Shape集合下添加了一个Chart。
随着Intellisense开除，很容易设置参数。
其余部分与您的代码相同，颜色略有不同。
希望这会有所帮助。