今天给大家分享一个另类的图表制作的示例。
先来看一下示例
从上面的演示中我们可以看到图表比access自带的好看多了，图中的图表是用网页开发的，利用开源的echarts来制作，echarts非常的强大，可以制作出非常漂亮的图表。图中的示例是直接用官网的示例，大家有兴趣可以去了解一下。
接下来我们就来看一下，怎么来实现这个功能。
1、添加控件
先添加一个web Browser 控件，注意这里我们要用到ActiveX控件。
2、添加代码
添加代码前你需要先从echarts官网下载对应的JS文件，然后我们需要写好html代码然后将代码放到vba中运行
加载事件
1Private Sub Form_Load()
2 Dim strHtml As String
3 Dim doc As IHTMLDocument5
4
5 Me.webChart.Navigate "about:blank"
6 Set doc = Me.webChart.Document
7
8 strHtml = strHtml & " <!DOCTYPE html>" & vbCr
9 strHtml = strHtml & " <html lang=""en""> " & vbCr
10 strHtml = strHtml & " <head>" & vbCr
11 strHtml = strHtml & " <meta charset=""UTF-8""> " & vbCr
12 strHtml = strHtml & " <title>Document</title>" & vbCr
13 strHtml = strHtml & " <script type=""text/javascript"" src=""D:\桌面文件\学习\echarts.min.js""></script> " & vbCr
14
15 strHtml = strHtml & " </head>" & vbCr
16 strHtml = strHtml & " <body>" & vbCr
17 strHtml = strHtml & " <div style=""border: 0px solid #666; width:700px; height:350px; float: left"" id=""myChart""></div> " & vbCr
18
19 strHtml = strHtml & " </body>" & vbCr
20 strHtml = strHtml & " <script type=""text/javascript""> " & vbCr
21
22 strHtml = strHtml & " option = {" & vbCr
23 strHtml = strHtml & " title: {" & vbCr
24 strHtml = strHtml & " text: '堆叠区域图'" & vbCr
25 strHtml = strHtml & " }," & vbCr
26 strHtml = strHtml & " tooltip: {" & vbCr
27 strHtml = strHtml & " trigger: 'axis'," & vbCr
28 strHtml = strHtml & " axisPointer: {" & vbCr
29 strHtml = strHtml & " type: 'cross'," & vbCr
30 strHtml = strHtml & " label: {" & vbCr
31 strHtml = strHtml & " backgroundColor: '#6a7985'" & vbCr
32 strHtml = strHtml & " }" & vbCr
33 strHtml = strHtml & " }" & vbCr
34 strHtml = strHtml & " }," & vbCr
35 strHtml = strHtml & " legend: {" & vbCr
36 strHtml = strHtml & " data: ['邮件营销', '联盟广告', '视频广告', '直接访问', '搜索引擎']" & vbCr
37 strHtml = strHtml & " }," & vbCr
38 strHtml = strHtml & " toolbox: {" & vbCr
39 strHtml = strHtml & " feature: {" & vbCr
40 strHtml = strHtml & " saveAsImage: {}" & vbCr
41 strHtml = strHtml & " }" & vbCr
42 strHtml = strHtml & " }," & vbCr
43 strHtml = strHtml & " grid: {" & vbCr
44 strHtml = strHtml & " left: '3%'," & vbCr
45 strHtml = strHtml & " right: '4%'," & vbCr
46 strHtml = strHtml & " bottom: '3%'," & vbCr
47 strHtml = strHtml & " containLabel: true" & vbCr
48 strHtml = strHtml & " }," & vbCr
49 strHtml = strHtml & " xAxis: [" & vbCr
50 strHtml = strHtml & " {" & vbCr
51 strHtml = strHtml & " type: 'category'," & vbCr
52 strHtml = strHtml & " boundaryGap: false," & vbCr
53 strHtml = strHtml & " data: ['周一', '周二', '周三', '周四', '周五', '周六', '周日']" & vbCr
54 strHtml = strHtml & " }" & vbCr
55 strHtml = strHtml & " ]," & vbCr
56 strHtml = strHtml & " yAxis: [" & vbCr
57 strHtml = strHtml & " {" & vbCr
58 strHtml = strHtml & " type: 'value'" & vbCr
59 strHtml = strHtml & " }" & vbCr
60 strHtml = strHtml & " ]," & vbCr
61 strHtml = strHtml & " series: [" & vbCr
62 strHtml = strHtml & " {" & vbCr
63 strHtml = strHtml & " name: '邮件营销'," & vbCr
64 strHtml = strHtml & " type: 'line'," & vbCr
65 strHtml = strHtml & " stack: '总量'," & vbCr
66 strHtml = strHtml & " areaStyle: {}," & vbCr
67 strHtml = strHtml & " data: [120, 132, 101, 134, 90, 230, 210]" & vbCr
68 strHtml = strHtml & " }," & vbCr
69 strHtml = strHtml & " {" & vbCr
70 strHtml = strHtml & " name: '联盟广告'," & vbCr
71 strHtml = strHtml & " type: 'line'," & vbCr
72 strHtml = strHtml & " stack: '总量'," & vbCr
73 strHtml = strHtml & " areaStyle: {}," & vbCr
74 strHtml = strHtml & " data: [220, 182, 191, 234, 290, 330, 310]" & vbCr
75 strHtml = strHtml & " }," & vbCr
76 strHtml = strHtml & " {" & vbCr
77 strHtml = strHtml & " name: '视频广告'," & vbCr
78 strHtml = strHtml & " type: 'line'," & vbCr
79 strHtml = strHtml & " stack: '总量'," & vbCr
80 strHtml = strHtml & " areaStyle: {}," & vbCr
81 strHtml = strHtml & " data: [150, 232, 201, 154, 190, 330, 410]" & vbCr
82 strHtml = strHtml & " }," & vbCr
83 strHtml = strHtml & " {" & vbCr
84 strHtml = strHtml & "name: '直接访问', " & vbCr
85 strHtml = strHtml & " type: 'line'," & vbCr
86 strHtml = strHtml & " stack: '总量'," & vbCr
87 strHtml = strHtml & " areaStyle: {}," & vbCr
88 strHtml = strHtml & " data: [320, 332, 301, 334, 390, 330, 320]" & vbCr
89 strHtml = strHtml & " }," & vbCr
90 strHtml = strHtml & " {" & vbCr
91 strHtml = strHtml & " name: '搜索引擎'," & vbCr
92 strHtml = strHtml & " type: 'line'," & vbCr
93 strHtml = strHtml & " stack: '总量'," & vbCr
94 strHtml = strHtml & " label: {" & vbCr
95 strHtml = strHtml & " normal: {" & vbCr
96 strHtml = strHtml & " show: true," & vbCr
97 strHtml = strHtml & " position: 'top'" & vbCr
98 strHtml = strHtml & " }" & vbCr
99 strHtml = strHtml & " }," & vbCr
100 strHtml = strHtml & " areaStyle: {}," & vbCr
101 strHtml = strHtml & " data: [820, 932, 901, 934, 1290, 1330, 1320]" & vbCr
102 strHtml = strHtml & " }" & vbCr
103 strHtml = strHtml & " ]" & vbCr
104 strHtml = strHtml & " };" & vbCr
105
106 strHtml = strHtml & " var myChart = echarts.init(document.getElementById('myChart'));" & vbCr
107
108 strHtml = strHtml & " myChart.setOption(option);" & vbCr
109 strHtml = strHtml & " </script>" & vbCr
110 strHtml = strHtml & " </html>" & vbCr
111 'Debug.Print strHtml
112 DoCmd.SetWarnings False
113
114 doc.Write strHtml
115 Me.webChart.Requery
116
117
118End Sub
3、运行测试
第三步就是运行测试一下。测试的结果就是第一张图片的显示。
最后，我要说的是，我们的代码中运用到了大量的html、JS等知识，所以我还是建议大家如果要做图表，还是用access自带的图表控件。
另外，图表的数据都固定的值，这个以后我们可以考虑做成是动态的，从当前的Access中取到。
