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

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

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

 1Public Function UpdateXmlData(ByVal vConnect As String, ByVal vSQL As String, Optional ByVal FullData As Boolean = True) As String
 2
 3    UpdateXmlData = ""
 4
 5    If Trim(vSQL) = "" Then
 6        Err.Raise 1011, Err.Source, "需要执行的 SQL 语句为空，不能执行。"
 7        Exit Function
 8    End If
 9    
10    Dim objConnection As New ADODB.Connection
11    Dim objRecordset As New ADODB.Recordset
12    
13On Error GoTo errConn
14    objConnection.Open vConnect
15On Error GoTo errReco
16    objRecordset.Open vSQL, objConnection, 1, 1
17On Error GoTo 0
18
19    Dim objXMLDOM As Object
20    Set objXMLDOM = CreateObject("MSXML2.DOMDocument")
21    
22    objRecordset.Save objXMLDOM, 1
23
24    Set objRecordset = Nothing
25    Set objConnection = Nothing
26
27    Dim objXMLDOM_XSLT As Object
28    Set objXMLDOM_XSLT = CreateObject("MSXML2.DOMDocument")
29                   
30    'objXMLDOM_XSLT.Load App.Path & "\ReportForms.xsl"
31    
32    Dim tmpAmount As String
33    tmpAmount = ""
34    If Not FullData Then
35        tmpAmount = "[position() < 3]"
36    End If
37    
38    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        
61    
62    UpdateXmlData = objXMLDOM.transformNode(objXMLDOM_XSLT)
63    
64    Set objXMLDOM = Nothing
65    Set objXMLDOM_XSLT = Nothing
66
67    Exit Function
68    
69errConn:
70    Err.Raise 1012, Err.Source, "无法连接用“" & vConnect & "”连接到数据库。"
71    Exit Function
72errReco:
73    Err.Raise 1010, Err.Source, "执行的 SQL 语句“" & vSQL & "”时发生错误。"
74    Exit Function
75End Function

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

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

 1
 2
 3    Set tmpExcel = CreateObject("Excel.Application")
 4    Set ExcelWorkbook = tmpExcel.Workbooks.Open("模板文件")
 5
 6    ExcelWorkbook.Application.DisplayAlerts = False
 7    
 8    Dim tmpXmlValue As String
 9
10    '***************************************
11    '在 tmpXmlValue 变量中存入最新的 XML 数据。
12    '***************************************
13    
14    '把 XML 数据更新到 Excel 中
15    ExcelWorkbook.XmlMaps("映射名称").ImportXml tmpXmlValue
16    '删除 XML 映射
17    ExcelWorkbook.XmlMaps("映射名称").Delete
18
19    '下边这个循环是把在 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
26    '存盘
27    ExcelWorkbook.SaveAs "新文件名", -4143
28
29    ExcelWorkbook.Application.DisplayAlerts = True
30
31

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

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