利用 Excel 做可视化的报表设计器!

我在几个月前给客户做报表时，客户提出这样一个要求，要在报表生成后在打印前用户还能对表格进行调整，比如人为根据感官调整字体的大小行间距等，当时在网上找了些报表控件看了一下，都不能满足后期调整的要求，而且购买第三方的控件又增加公司的成本，又需对实施人员和用户管理员进行相关的技术培训。最后决定还是用最常用的报表设计工具 Excel 来完成这件事。

在 Excel 中有一个“XML映射”功能，是把 XML 当成数据源映射到 Excel 中来，我们就可以利用这个功能把我们需要做报表的数据生成成XML然后映射到 Excel 中，让实施人员或用户管理员可以在 Excel 这个熟悉的环境中来进行可视化的报表设计。下边这个“UpdateXmlData”函数就是实现连接到一个数据库并执行一句SQL语句然后用ADO把数据存为XML并用XSLT过滤掉无用信息，返回一个XML的字符串。

Public Function UpdateXmlData(ByVal vConnect As String, ByVal vSQL As String, Optional ByVal FullData As Boolean = True) As String
2

UpdateXmlData = ""
4

If Trim(vSQL) = "" Then
6

Err.Raise 1011, Err.Source, "需要执行的 SQL 语句为空，不能执行。"
7

Exit Function
8

End If
9

Dim objConnection As New ADODB.Connection
11

Dim objRecordset As New ADODB.Recordset
12

On Error GoTo errConn
14

objConnection.Open vConnect
15

On Error GoTo errReco
16

objRecordset.Open vSQL, objConnection, 1, 1
17

On Error GoTo 0
18

Dim objXMLDOM As Object
20

Set objXMLDOM = CreateObject("MSXML2.DOMDocument")
21

objRecordset.Save objXMLDOM, 1
23

Set objRecordset = Nothing
25

Set objConnection = Nothing
26

Dim objXMLDOM_XSLT As Object
28

Set objXMLDOM_XSLT = CreateObject("MSXML2.DOMDocument")
29

\'objXMLDOM_XSLT.Load App.Path & "\ReportForms.xsl"
31

Dim tmpAmount As String
33

tmpAmount = ""
34

If Not FullData Then
35

tmpAmount = "[position() < 3]"
36

End If
37

objXMLDOM_XSLT.loadXML "<?xml version=""1.0""?>" & _
39

"<xsl:stylesheet version=""1.0""" & _
40

" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform""" & _
41

" xmlns:s=""uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882""" & _
42

" xmlns:dt=""uuid:C2F41010-65B3-11d1-A29F-00AA00C14882""" & _
43

" xmlns:rs=""urn:schemas-microsoft-com:rowset""" & _
44

" xmlns:z=""#RowsetSchema"">" & _
45

"<xsl:output omit-xml-declaration=""yes""/>" & _
46

"<xsl:template match=""/"">" & _
47

"<xsl:element name=""数据描述"">" & _
48

"<xsl:for-each select=""/xml/rs:data/z:row" & tmpAmount & """>" & _
49

"<xsl:element name=""列名"">" & _
50

"<xsl:for-each select=""@*"">" & _
51

"<xsl:variable name=""SName"" select = ""name()""></xsl:variable>" & _
52

"<xsl:variable name=""QName"" select = ""/xml/s:Schema/s:ElementType/s:AttributeType[@name=$SName]/@rs:name""></xsl:variable>" & _
53

"<xsl:choose><xsl:when test=""not($QName)"">" & _
54

"<xsl:attribute name=""{name()}""><xsl:value-of select="".""/></xsl:attribute>" & _
55

"</xsl:when><xsl:when test=""$QName"">" & _
56

"<xsl:attribute name=""{$QName}""><xsl:value-of select="".""/></xsl:attribute>" & _
57

"</xsl:when></xsl:choose>" & _
58

"</xsl:for-each></xsl:element></xsl:for-each>" & _
59

"</xsl:element></xsl:template></xsl:stylesheet>"
60

UpdateXmlData = objXMLDOM.transformNode(objXMLDOM_XSLT)
63

Set objXMLDOM = Nothing
65

Set objXMLDOM_XSLT = Nothing
66

Exit Function
68

errConn:
70

Err.Raise 1012, Err.Source, "无法连接用“" & vConnect & "”连接到数据库。"
71

Exit Function
72

errReco:
73

Err.Raise 1010, Err.Source, "执行的 SQL 语句“" & vSQL & "”时发生错误。"
74

Exit Function
75

End Function

当然更复杂的数据就只有定制写一个程序来生成XML了。

最后就是根据设计好的报表自动更新数据源生成 Excel 文件了。

Set tmpExcel = CreateObject("Excel.Application")
4

Set ExcelWorkbook = tmpExcel.Workbooks.Open("模板文件")
5

ExcelWorkbook.Application.DisplayAlerts = False
7

Dim tmpXmlValue As String
9

\'***************************************
11

\'在 tmpXmlValue 变量中存入最新的 XML 数据。
12

\'***************************************
13

\'把 XML 数据更新到 Excel 中
15

ExcelWorkbook.XmlMaps("映射名称").ImportXml tmpXmlValue
16

\'删除 XML 映射
17

ExcelWorkbook.XmlMaps("映射名称").Delete
18

\'下边这个循环是把在 Excel 中的所有列表对象都取消掉。
20

For i = 1 To ExcelWorkbook.Worksheets.Count
21

For j = 1 To ExcelWorkbook.Worksheets(i).ListObjects.Count
22

ExcelWorkbook.Worksheets(i).ListObjects(1).Unlist
23

Next j
24

Next i
25

\'存盘
27

ExcelWorkbook.SaveAs "新文件名", -4143
28

ExcelWorkbook.Application.DisplayAlerts = True
30

这样就可以实现可视化的报表设计了，而且生成最终的报表后是一个 Excel 文件，客户也能进行后期调整了。

上边这些只是主要思路的代码，要实现完整的可视化设计，肯定还有很多其它的细节需要注意，比如支持多个映射、图形报表等。