vba变成实现自动生成饼图柱状图并保存为jpg图片

excelapprentice

大家好，我想根据销售数据自动生成对应的图表，并且将图表自动导出为jpg格式的图片，附件里我对要求实现的一些细节做了说明。之前领教过vba自动处理数据的高效，所以猜想vba还是解决以上需求的最优选，如果还有其他的办法，也请大神指教，我会对能解决问题的大神发两张红装毛主席红包，微表谢意，看不上的另当别论。
另外，我只能选择用excel，公司的数据不能上传外网，希望大神能给出具体的解决方案，而不是给指个方向，非常感谢。
附件解压后有两部分，一个是销售数据和要生成的图表，另外一个是类似的用vba实现自动数据处理的例子（也可见我之前的一个求助帖）。

还有就是，这种自动生成对应的图表并导出为jpg图片，是一个表一个表的处理呢？还是三张表可以一起处理？当然后者更高效，但是不知道能不能实现。

micch

1. Sub test()
   
2.     With Sheet1
   
3.         Set Rng = .[a1].CurrentRegion.Offset(1)
   
4.         arr = Rng
   
5.         '客流占比
   
6.         Rng.Sort Rng(1), 1
   
7.         Set cht = .ChartObjects("图表 1")
   
8.                 cht.Chart.ChartTitle.Text = "国美店日客流量部门占比示意图"
   
9.                 a = Application.Transpose(.[c2].Resize(UBound(arr) - 1))
   
10.                 b = Application.Transpose(.[b2].Resize(UBound(arr) - 1))
    
11.         With cht.Chart.SeriesCollection(1)
    
12.             .Values = a
    
13.             .XValues = b
    
14.             .HasDataLabels = True
    
15.             .HasLeaderLines = True
    
16.             .DataLabels.NumberFormat = "0.00%"
    
17.             .DataLabels.ShowCategoryName = True
    
18.             .DataLabels.ShowPercentage = True
    
19.             .DataLabels.Position = xlLabelPositionBestFit
    
20.         End With
    
21.         myname$ = ThisWorkbook.Path & "" & cht.Chart.ChartTitle.Text & ".jpeg"
    
22.         cht.Chart.Export Filename:=myname, FilterName:="jpeg"
    
23.          '客流分布
    
24.         Rng.Sort Rng(3), 2
    
25.         Set cht = .ChartObjects("图表 2")
    
26.                 cht.Chart.ChartTitle.Text = "国美店日客流量部门分布示意图"
    
27.                 a = Application.Transpose(.[c2].Resize(UBound(arr) - 1))
    
28.                 b = Application.Transpose(.[b2].Resize(UBound(arr) - 1))
    
29.         With cht.Chart.SeriesCollection(1)
    
30.             .Values = a
    
31.             .XValues = b
    
32.             .Name = "客流量"
    
33.             .HasDataLabels = True
    
34.             .DataLabels.NumberFormat = "0"
    
35.             .DataLabels.Position = xlLabelPositionOutsideEnd
    
36.         End With
    
37.         myname$ = ThisWorkbook.Path & "" & cht.Chart.ChartTitle.Text & ".jpeg"
    
38.         cht.Chart.Export Filename:=myname, FilterName:="jpeg"
    
39.          '销售额
    
40.         Rng.Sort Rng(5), 1
    
41.         Set cht = .ChartObjects("图表 3")
    
42.                 cht.Chart.ChartTitle.Text = "国美店日销售额排名"
    
43.                 a = Application.Transpose(.[e2].Resize(UBound(arr) - 1))
    
44.                 b = Application.Transpose(.[b2].Resize(UBound(arr) - 1))
    
45.         With cht.Chart.SeriesCollection(1)
    
46.             .Name = "实际销售额"
    
47.             .Values = a
    
48.             .XValues = b
    
49.             .HasDataLabels = True
    
50.             .DataLabels.NumberFormat = "0"
    
51.             .DataLabels.Position = xlLabelPositionOutsideEnd
    
52.         End With
    
53.         myname$ = ThisWorkbook.Path & "" & cht.Chart.ChartTitle.Text & ".jpeg"
    
54.         cht.Chart.Export Filename:=myname, FilterName:="jpeg"
    
55.         .[a2].Resize(UBound(arr), 5) = arr
    
56.     End With
    
57. End Sub

复制代码

excelapprentice

micch 发表于 2020-1-31 12:05

收到，多谢，我试试看