SAP资产负债表实现方案探索 - 基于 VBA 自定义函数方法

本篇接着SAP资产负债表实现方案探索 - 基于 Excel-DNA 自定义函数方法这篇博文，继续介绍通过 VBA 编写自定义函数来实现资产负债表的方法。在上一篇文章中，整体解决方案的思路可以分为两个步骤：（1）SAP 提供 Restful Service，允许外部获取 json 格式的科目余额表；(2) Excel 通过自定义函数从 Restful Service 中获取所需要的数据。

因为上一篇已经介绍了在 SAP 中如何提供 SAP Restful 服务，这里就不重复了，直接从在 Excel 中通过 VBA 自定义函数开始。

将 VBA 自定义函数放到加载宏中

为了实现自定义函数的复用，可以将自定义的函数放到加载宏 (add-in) 中，方法是将 Excel 文件另存为 Excel 加载宏，Excel 加载宏的扩展名为 xlam。

在每台 PC 上都有默认的 Excel 加载宏位置，放在默认位置的加载宏能在「Excel加载宏」对话框中显示，放在其他位置的加载宏能通过浏览的方式找到并加载。默认位置：C:\Users\UserName\AppData\Roaming\Microsoft\AddIns

Excel 通过 VBA 使用 Restful Service 需要解决两个问题：1）发送和接收 Http 请求，可以使用 Microsoft WinHTTP Service 5.1 这个库来实现，之前的博文有讲解过。本例因为只涉及到 Get 请求，可以使用 Excel 的 WebService 函数；2）第二个问题是对 json 数据的解析，我使用了 github 上一个开源的代码：VBA-tools/VBA-JSON: JSON conversion and parsing for VBA。

有了上面的准备工作，编写 BsItemAmount 函数用于从 SAP 获取报表项余额：

Public Const BaseUrl As String = "http://sapecc6:8000/sap/zrfc/"Public Enum amtTypeEnumYEAR_BEGIN = 1PERIOD_BEGIN = 2PERIOD_DEBIT = 3PERIOD_CREDIT = 4PERIOD_NET = 5CLOSING = 6
End EnumPublic Function BsItemAmount(companyCode As String, year As String, period As String, fsItem As String, amountType As amtTypeEnum) As DoubleDim jsonData As StringDim url As StringDim parsedDict As DictionaryDim rv As Double ' 返回值url = BaseUrl & "Z_BS_BALANCES?COMPANYCODE=" & companyCode & "&FISCALYEAR=" & year & "&FISCALPERIOD=" & periodjsonData = Application.WorksheetFunction.WebService(url)Set parsedDict = JsonConverter.parseJson(jsonData)Dim val As DictionaryFor Each val In parsedDict("FS_BALANCES")If val("FSITEM") = fsItem ThenIf amountType = amtTypeEnum.YEAR_BEGIN Thenrv = val("YR_OPENBAL")ElseIf amountType = amtTypeEnum.PERIOD_BEGIN Thenrv = val("OPEN_BALANCE")ElseIf amountType = amtTypeEnum.PERIOD_DEBIT Thenrv = val("DEBIT_PER")ElseIf amountType = amtTypeEnum.PERIOD_CREDIT Thenrv = val("CREDIT_PER")ElseIf amountType = amtTypeEnum.PERIOD_NET Thenrv = val("PER_AMT")ElseIf amountType = amtTypeEnum.CLOSING Thenrv = val("BALANCE")End IfExit ForEnd IfNextBsItemAmount = rv
End Function

我们先对代码的功能做一个大致说明，后面再展开讲解关键的细节。上面这段代码做了两件事，先用 Excel 内置的 WebService 函数获取 SAP Restful service 的值，返回值为 json 字符串，然后通过 JsonConverter 对 json 字符串进行解析。 Json 字符串中的对象 (也就是花括号包括的部分）解析为 Dictionary，将 Json 字符串中的数组 (也就是方括号包括的部分) 解析为 Collection。

使用加载宏中的自定义函数

打开一个新的 Excel 工作簿，切换到「开发工具」页签，点击「Excel加载项」

从弹出对话框中选择合适的加载宏，如果加载宏不在默认位置，点击浏览按钮选择目标文件。

然后就可以愉快地使用自定义函数了（类别为：用户定义）

Restful Service 加载到 Excel 的方法

在写上面函数的时候，发现 VBA 在调试 Dictionary 或者 Collection 的时候挺不直观的，为了方便自己查看数据，就想着将数据导出到 Excel 工作表中。数据导出大体可以用两种方法。

方法一：基于解析的 Collection 和 Dictionary 写入工作表，代码如下：

Public Sub DataToSheet(data As Collection, shtName As String)' data的类型为JsonConverter的parseJson()方法的返回值，而不是普通的CollectionDim sht As WorksheetSet sht = ActiveWorkbook.Sheets(shtName)Dim topLeftCell As RangeSet topLeftCell = sht.Range("A1")' 在第一行打印表头Dim firstRow As New DictionaryDim k As VariantDim col As IntegerSet firstRow = data.Item(1)col = 0 ' col indexFor Each k In firstRow.KeystopLeftCell.Offset(0, col) = CStr(k)col = col + 1Next' 打印line item的值Dim val As DictionaryDim row As Integer ' row indexrow = 0col = 0For Each val In dataFor Each k In val.KeystopLeftCell.Offset(row + 1, col) = val(k)col = col + 1Nextcol = 0row = row + 1Next
End Sub

测试代码：

Public Sub WriteToSheetTest(ByVal shtName As String)Dim jsonData As StringDim url As StringDim parsedDict As Dictionaryurl = BaseUrl & "Z_BS_BALANCES?COMPANYCODE=Z900&FISCALYEAR=2020&FISCALPERIOD=10"jsonData = Application.WorksheetFunction.WebService(url)Set parsedDict = JsonConverter.parseJson(jsonData)Dim data As New CollectionSet data = parsedDict("FS_BALANCES")Call DataToSheet(data, shtName)
End Sub

方法二：将数据加载到 ADODB.RecordSet，利用 VBA 中 Excel Range 提供的 CopyFromRecordSet() 将数据导入 Excel 工作表。代码如下：

Public Function DataToRecordSet(data As Collection) As ADODB.RecordsetDim rst As New ADODB.RecordsetDim firstRow As New DictionaryDim k As VariantSet firstRow = data.Item(1)
'    For Each k In firstRow.Keys
'        rst.Fields.Append k, adVarChar, 50, adFldMayBeNull
'    Nextrst.Fields.Append firstRow.Keys(0), adVarChar, 50, adFldKeyColumnrst.Fields.Append firstRow.Keys(1), adDoublerst.Fields.Append firstRow.Keys(2), adDoublerst.Fields.Append firstRow.Keys(3), adDoublerst.Fields.Append firstRow.Keys(4), adDoublerst.Fields.Append firstRow.Keys(5), adDoublerst.Fields.Append firstRow.Keys(6), adDoublerst.CursorType = adOpenKeysetrst.CursorLocation = adUseClientrst.LockType = adLockPessimisticDim val As DictionaryDim col As Integer' 加载数据rst.OpenFor Each val In datarst.AddNewcol = 0For Each k In val.Keysrst.Fields(col) = val(k)col = col + 1Nextrst.UpdateNextSet DataToRecordSet = rst
End Function

注释掉的代码提供了更通用的功能，但因为数据类型无法确定，都默认为 varchar，效果不好，就改为根据数据本身的类型来确定 RecordSet 字段的数据类型。

测试代码如下。先编写一个函数来获取值：

Public Function GetRecordSet() As ADODB.RecordsetDim jsonData As StringDim url As StringDim parsedDict As Dictionaryurl = BaseUrl & "Z_BS_BALANCES?COMPANYCODE=Z900&FISCALYEAR=2020&FISCALPERIOD=10"jsonData = Application.WorksheetFunction.WebService(url)Set parsedDict = JsonConverter.parseJson(jsonData)Dim data As New CollectionSet data = parsedDict("FS_BALANCES")Dim rst As New ADODB.RecordsetSet rst = DataToRecordSet(data)Set GetRecordSet = rst
End Function

然后再将数据导出到工作表：

Public Sub ExportDataTest()Dim rst As New ADODB.RecordsetSet rst = StoneSAPFunctions.printModule.GetRecordSet' print headerDim col As IntegerFor col = 0 To rst.Fields.Count - 1Sheet1.Range("A1").Offset(0, col) = rst.Fields(col).NameNext' print line itemsrst.MoveFirstSheet1.Range("A2").CopyFromRecordset rst
End Sub

在 CopyFromRecordset() 方法前，需要调用 Recordset 的 MoveFirst() 方法，否则游标处在最后一行，只打印出最后一行。