之前给大家分享了如何用一个函数制作各种常见图表,之后有朋友问,下图中表示精确占比的饼图是怎么批量生成的?
批量生成小饼图有两种常用的方法,一种是用插件,比如Sparklines;另外一种是自己动手丰衣足食,摊手,也就写点VBA小代码得啦。
复制运行以下VBA代码,选择占比值所在的单元格区域,即可批量生成小饼图。
Sub vbaPie()
Dim cht As ChartObject, rngData As Range, rng As Range
On Error Resume Next
For Each cht In ActiveSheet.ChartObjects '删除旧图
If InStr(cht.Name, "公众号Excel星球") Then cht.Delete
Next
Set rngData = Application.InputBox("请选择数据区域", Default:=Selection.Address, Type:=8)
If Err Then Exit Sub
rngData.Parent.Select
Set rngData = Intersect(rngData, ActiveSheet.UsedRange)
If rngData Is Nothing Then MsgBox "请选择有效数据区域": Exit Sub
For Each rng In rngData '遍历单元格
Call CreateCht(rng, Array(rng.Value, 1 - rng.Value))
Next
rngData(1).Select
End Sub
Function CreateCht(rng As Range, aRef)
On Error Resume Next
Dim cht As ChartObject
Set cht = ActiveSheet.ChartObjects.Add(100, 100, 200, 200)
With cht.Chart '图表
.ChartType = xlPie '指定图表类型
.SeriesCollection.NewSeries '新系列
.SeriesCollection (1)
With .SeriesCollection(1)
.Values = aRef '数据
.Points(1).Format.Fill.ForeColor.RGB = RGB(64, 64, 64) '占比颜色
.Points(2).Format.Fill.ForeColor.RGB = RGB(166, 166, 166) '其它占比颜色
End With
.ApplyDataLabels -xlDataLabelsShowNone '干掉标签
.Legend.Delete '干掉图例
.ChartTitle.Delete '干掉标题
With .PlotArea '设置绘图区大小
.Select
.Top = 0
.Height = 170
.Width = 170
.Left = 0
End With
End With
cht.Name = "看见星光" & rng.Address '图表命名
With ActiveSheet.Shapes(cht.Name)
.Fill.Visible = msoFalse '取消填充色
.Line.Visible = msoFalse '取消线条色
.Height = rng.Height '高
.Width = rng.Height '宽
.Top = rng.Top + 1 '位置top
.Left = rng.Left + 1 '位置left
End With
End Function
技术交流,软件开发,欢迎微信沟通: