加载中…excel批量生成条形统计图
(2020-01-16 15:04:15)| 分类： soft-excel |
excel列标题
班序 姓名 语文 数学 英语 物理 化学 思品 历史 总分 班级
用法是生成统计图, 然后全部复制到word中, 刚好一页六个表格(适当调整下边距)
两个宏代码如下
Sub 批量生成成绩图表()
Dim myChart, Ra As ChartObject
Dim myFileName As String
Dim iii, jjj As Integer
With ActiveSheet
'先虚加一个图表对象,解决下文循环开头删除空集问题
Set myChart = .ChartObjects.Add(520, 40, 360, 250)
'取数据总行数，第一行为标题，最后一行为平均值
jjj = ActiveSheet.[b65536].End(xlUp).Row
'从第2行开始循环，i代表第几行
.ChartObjects.Delete
For iii = 2 To jjj
'清除原有图表
'颜色搭配8,35
'.指定图表位置和大小
Set myChart = .ChartObjects.Add(520, 0 + 250 * (iii - 2), 360,
250)
With myChart.Chart
'第一个数据系列，员工各项考核值
.ChartType = xlColumnClustered
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues =
ActiveSheet.Range("c1:i1")
'上面指定了横坐标的标签为第几列到几列
.SeriesCollection(1).Values = ActiveSheet.Range("c" & iii
& ":i" & iii)
'上面指定了柱子数据的来源为第几列到几列
.SeriesCollection(1).Name = ActiveSheet.Range("j" &
iii)
'上面指定了统计图右边的“标注”
'第二个数据序列，各项考核平均值，位于sheet最后一行
'.指定图表生成的位置
'.Location Where:=xlLocationAsObject, Name:="成绩图表"
'显示标签值
.ApplyDataLabels ShowValue:=True
'显示图表标题
.HasTitle = True
.ChartTitle.Text = ActiveSheet.Cells(iii, 2)
'.设置图表标题的字体
With .ChartTitle.Font
.Size = 20
.ColorIndex = 1
.Name = "华文新魏"
End With
'.设置图表区域的颜色
With .ChartArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
'.设置绘图区域的颜色
With .PlotArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
'.设置是否显示Y轴刻度
myChart.Chart.HasAxis(xlValue, xlPrimary) = True
Set myChart = ActiveSheet.ChartObjects(1).Chart
'使用第一列值命名图像，请勿重复
myFileName = ActiveSheet.Cells(iii, 2) & ".jpg"
On Error Resume Next
'.删除原有同名文件
Kill ThisWorkbook.Path & "\imgfile\" &
myFileName
'.将图表转换为图像并输出到指定目录，使之与H列的值相对应
myChart.Export Filename:=ThisWorkbook.Path & "\imgfile\"
& myFileName, Filtername:="JPG"
End With
'.清空对象
Set myChart = Nothing
Next iii
End With
End Sub
Sub 清除图表()
For Each r In ActiveSheet.ChartObjects
r.Delete
Next
End Sub
喜欢
0
赠金笔