|
[tr][td]学校利用mood的反馈单让学生评价自己的老师，每个老师10个问题，每个问题3个选项，形成了一个庞大大统计报表，教导处认为不直观，需要把有问题的选项找出来，并用图表的形式显示出来，我就琢磨了两个小时，做了下面一段小程序。可以实现将学生对老师不满意度达到10%的数据筛选出来，并形成图表。
代码如下: Private Sub CommandButton1_Click() 设置该图表是哪个年级的，用于下面生成图表名用 Filename = Sheet10.Range("a3") '设置第一饼图的起始参数位置，也是饼图生成阈值所要侦测的位置 i = Sheet10.Range("b3") '饼图生成的阈值 Threshold = Sheet10.Range("c3") '如果反馈单中d列有值就循环，直到最后 Do While Sheet2.Range("d" & i) > "" '如果反馈单中d“i”单元格的值达到阈值就生成图表 If Sheet2.Range("d" & i) >= Threshold Then '生成图表开始 Charts.Add ActiveChart.ChartType = xlPie ActiveChart.SetSourceData Source:=Sheets("反馈单").Range("B" & i - 2 & ":D" & i), PlotBy:= _xlRows 'ActiveChart.SeriesCollection(1).Name = "=反馈单!R" & i - 2 & "C1" ActiveChart.SeriesCollection(1).Name = "=反馈单!R" & i - 2 & "C1" '生成图表结束 '设置图表数据标签开始 ActiveChart.SeriesCollection(1).Select ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= True, ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False '设置图表数据标签结束 '图表命名开始 ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Filename & Sheets("反馈单").Range("A" & i - 2) With ActiveChart .HasTitle = True End With '图表命名结束 End If '自增3准备下一次循环 i = i + 3 Loop '同目录存盘 ThisWorkbook.SaveAs ThisWorkbook.Path & "" & Filename & "教评反馈图表生成.xls" End Sub (转自胡益兵的博客) [/td][/tr] |
|
