利用VBA在Excel中批量画图

有很多图要画的时候要崩溃的,必须上VBA来解决。比如现在有个Excel数据表,研究五个竞争对手,每个竞争对手都生产有四种设备,每个设备都有可能具有8个效果中的几个。现在要研究五个竞争对手的专利情况。要用饼图来表示五个竞争对手在某种设备的某个效果方面分别有几篇相关专利。原数据表如下:
在这里插入图片描述
每个设备对应的每个效果都要画一个饼图,用来表示五个竞争对手的情况。代码如下:

Sub pie()

Dim x, y, z As Integer '定义三个整数便于计算
Set WK = ThisWorkbook.Sheets("竞争对手") '定义工作表
If WK.ChartObjects.Count > 0 Then WK.ChartObjects.Delete '如果工作表有图表,就全删掉
For x = 0 To 31 '一共要画32个图表
    y = x \ 8 '用x除以8后取整数,得到有多少行图表
    z = x Mod 8 '用x除以8后取模,得到有多少列图表
    Dim aChart As Chart '定义绘图区域
    Dim aChartObject As ChartObject '定义图表对象
    '定义每个图表的左上角坐标
    Set aChartObject = WK.ChartObjects.Add(10 + z * 110, 400 + y * 110, 100, 100)
    '定义图表
    Set aChart = aChartObject.Chart
    With aChart '对于每个图表,取数据,画饼图,背景和线条都设置透明,加上数据标签
        .ChartWizard Source:=WK.Range(Cells(2 + y * 5, 3 + z), Cells(6 + y * 5, 3 + z)), gallery:=xlPie, HasLegend:=False
        .ChartArea.Format.Fill.Visible = msoFalse
        .PlotArea.Format.Fill.Visible = msoFalse
        .ChartArea.Format.Line.Visible = msoFalse
        .SetElement (msoElementDataLabelBestFit)
    End With
Next

End Sub

这里面需要计算的是在哪里画图,代码是这句:10 + z * 110, 400 + y * 110, 100, 100。其中,10代表第一个小图距离工作表的最左端为10,z * 110代表每隔110就在第z列画一个图。400代表第一个小图距离工作表的最上端为400,y * 110代表每隔110就在第y行画一个图。第一个100 代表图的宽度,第二个100代表图的高度。

另外需要计算的就是取哪里的数据画图,代码是这句:Cells(2 + y * 5, 3 + z), Cells(6 + y * 5, 3 + z)。第一个Cells表示画图数据区域的左上角的单元格,第二个Cells表示画图数据区域的右下角的单元格。y和z分别帮助程序遍历每行和每列的画图数据区域。

最后的效果如下:

在这里插入图片描述
有三个画图数据区域是空的,所以那个地方就没有图,但是是有画布的,画布是透明的。

  • 4
    点赞
  • 40
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
Public Sub JJCC() QXAN = 0 On Error Resume Next CXKS If Dir("C:\windows\cxml.txt") = "" Then Exit Sub If sf Then Exit Sub Dim ss1 As AcadSelectionSet Dim ss2 As AcadSelectionSet Dim ss3 As AcadSelectionSet Dim lx As String lx = JSLX Dim jd As Integer Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select Dim pm1 As String Dim pre As String Dim pm2 As String Dim bm(0) As Integer Dim mc(0) As Variant Dim jg As Double bm(0) = 0 mc(0) = "*Text" Dim VBM As Variant Dim VMC As Variant VBM = bm VMC = mc Select Case lx Case "1" pm1 = "《当前计算类型为加(+)》输入 C 改变类型/回车继续:" Case "2" pm1 = "《当前计算类型为减(-)》输入 C 改变类型/回车继续:" Case "3" pm1 = "《当前计算类型为乘(*)》输入 C 改变类型/回车继续:" Case "4" pm1 = "《当前计算类型为除(/)》输入 C 改变类型/回车继续:" End Select ThisDrawing.Utility.Prompt (vbCrLf & pm1) pre = ThisDrawing.Utility.GetString(True) If pre = "C" Or pre = "c" Then QXAN = 0 UserForm1.Show 'If QXAN = 1 Then Exit Sub lx = JSLX Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select 'If QXAN = 1 Then Exit Sub End If Select Case lx Case "1" pm1 = "选择所有累加的数:" pm2 = "选择所有加数:" Case "2" pm1 = "选择所有被减数:" pm2 = "选择所有减数:" Case "3" pm1 = "选择所有累乘数:" pm2 = "选择所有乘数:" Case "4" pm1 = "选择所有被除数:" pm2 = "选择所有除数:" End Select

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值