SAP資產(chǎn)負(fù)債表實(shí)現(xiàn)方案探索 - 基于 VBA 自定義函數(shù)方法

本篇接著SAP資產(chǎn)負(fù)債表實(shí)現(xiàn)方案探索 - 基于 Excel-DNA 自定義函數(shù)方法
這篇博文蜕径，繼續(xù)介紹通過 VBA 編寫自定義函數(shù)來實(shí)現(xiàn)資產(chǎn)負(fù)債表的方法。在上一篇文章中，整體解決方案的思路可以分為兩個步驟：（1）SAP 提供 Restful Service，允許外部獲取 json 格式的科目余額表酌伊；(2) Excel 通過自定義函數(shù)從 Restful Service 中獲取所需要的數(shù)據(jù)购城。

因?yàn)樯弦黄呀?jīng)介紹了在 SAP 中如何提供 SAP Restful 服務(wù)，這里就不重復(fù)了匣沼，直接從在 Excel 中通過 VBA 自定義函數(shù)開始。

將 VBA 自定義函數(shù)放到加載宏中

為了實(shí)現(xiàn)自定義函數(shù)的復(fù)用捂龄，可以將自定義的函數(shù)放到加載宏 (add-in) 中释涛，方法是將 Excel 文件另存為 Excel 加載宏，Excel 加載宏的擴(kuò)展名為 xlam跺讯。

在每臺 PC 上都有默認(rèn)的 Excel 加載宏位置枢贿，放在默認(rèn)位置的加載宏能在「Excel加載宏」對話框中顯示，放在其他位置的加載宏能通過瀏覽的方式找到并加載刀脏。默認(rèn)位置：C:\Users\UserName\AppData\Roaming\Microsoft\AddIns

Excel 通過 VBA 使用 Restful Service 需要解決兩個問題：1）發(fā)送和接收 Http 請求局荚，可以使用 Microsoft WinHTTP Service 5.1 這個庫來實(shí)現(xiàn)，之前的博文有講解過。本例因?yàn)橹簧婕暗?Get 請求耀态，可以使用 Excel 的 WebService 函數(shù)轮傍；2）第二個問題是對 json 數(shù)據(jù)的解析，我使用了 github 上一個開源的代碼：VBA-tools/VBA-JSON: JSON conversion and parsing for VBA首装。

有了上面的準(zhǔn)備工作创夜，編寫 BsItemAmount 函數(shù)用于從 SAP 獲取報表項(xiàng)余額：

Public Const BaseUrl As String = "http://sapecc6:8000/sap/zrfc/"

Public Enum amtTypeEnum
    YEAR_BEGIN = 1
    PERIOD_BEGIN = 2
    PERIOD_DEBIT = 3
    PERIOD_CREDIT = 4
    PERIOD_NET = 5
    CLOSING = 6
End Enum


Public Function BsItemAmount(companyCode As String, year As String, period As String, fsItem As String, amountType As amtTypeEnum) As Double
    Dim jsonData As String
    Dim url As String
    Dim parsedDict As Dictionary
    Dim rv As Double ' 返回值
    
    url = BaseUrl & "Z_BS_BALANCES?COMPANYCODE=" & companyCode & "&FISCALYEAR=" & year & "&FISCALPERIOD=" & period
    jsonData = Application.WorksheetFunction.WebService(url)
    Set parsedDict = JsonConverter.parseJson(jsonData)
    
    Dim val As Dictionary
    For Each val In parsedDict("FS_BALANCES")
        If val("FSITEM") = fsItem Then
            If amountType = amtTypeEnum.YEAR_BEGIN Then
                rv = val("YR_OPENBAL")
            ElseIf amountType = amtTypeEnum.PERIOD_BEGIN Then
                rv = val("OPEN_BALANCE")
            ElseIf amountType = amtTypeEnum.PERIOD_DEBIT Then
                rv = val("DEBIT_PER")
            ElseIf amountType = amtTypeEnum.PERIOD_CREDIT Then
                rv = val("CREDIT_PER")
            ElseIf amountType = amtTypeEnum.PERIOD_NET Then
                rv = val("PER_AMT")
            ElseIf amountType = amtTypeEnum.CLOSING Then
                rv = val("BALANCE")
            End If
            
            Exit For
        End If
    Next
    
    BsItemAmount = rv
End Function

我們先對代碼的功能做一個大致說明，后面再展開講解關(guān)鍵的細(xì)節(jié)仙逻。上面這段代碼做了兩件事驰吓，先用 Excel 內(nèi)置的 WebService 函數(shù)獲取 SAP Restful service 的值，返回值為 json 字符串系奉，然后通過 JsonConverter 對 json 字符串進(jìn)行解析檬贰。 Json 字符串中的對象 (也就是花括號包括的部分）解析為 Dictionary，將 Json 字符串中的數(shù)組 (也就是方括號包括的部分) 解析為 Collection缺亮。

使用加載宏中的自定義函數(shù)

打開一個新的 Excel 工作簿翁涤，切換到「開發(fā)工具」頁簽，點(diǎn)擊「Excel加載項(xiàng)」

從彈出對話框中選擇合適的加載宏萌踱，如果加載宏不在默認(rèn)位置葵礼，點(diǎn)擊瀏覽按鈕選擇目標(biāo)文件。

然后就可以愉快地使用自定義函數(shù)了（類別為：用戶定義）

image

Restful Service 加載到 Excel 的方法

在寫上面函數(shù)的時候并鸵，發(fā)現(xiàn) VBA 在調(diào)試 Dictionary 或者 Collection 的時候挺不直觀的鸳粉，為了方便自己查看數(shù)據(jù)，就想著將數(shù)據(jù)導(dǎo)出到 Excel 工作表中园担。數(shù)據(jù)導(dǎo)出大體可以用兩種方法赁严。

方法一：將解析后的 Collection 和 Dictionary 寫入工作表，代碼如下：

Public Sub DataToSheet(data As Collection, shtName As String)
    ' data的類型為JsonConverter的parseJson()方法的返回值粉铐，而不是普通的Collection
    
    Dim sht As Worksheet
    Set sht = ActiveWorkbook.Sheets(shtName)
    
    Dim topLeftCell As Range
    Set topLeftCell = sht.Range("A1")
    
    ' 在第一行打印表頭
    Dim firstRow As New Dictionary
    Dim k As Variant
    Dim col As Integer
    Set firstRow = data.Item(1)
    col = 0 ' col index
    For Each k In firstRow.Keys
        topLeftCell.Offset(0, col) = CStr(k)
        col = col + 1
    Next
    
    ' 打印line item的值
    Dim val As Dictionary
    Dim row As Integer ' row index
    row = 0
    col = 0
    For Each val In data
        For Each k In val.Keys
            topLeftCell.Offset(row + 1, col) = val(k)
            col = col + 1
        Next
        col = 0
        row = row + 1
    Next
End Sub

測試代碼：

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

方法二：將數(shù)據(jù)加載到 ADODB.RecordSet，利用 VBA 中 Excel Range 提供的 CopyFromRecordSet() 將數(shù)據(jù)導(dǎo)入 Excel 工作表卤档。代碼如下：

Public Function DataToRecordSet(data As Collection) As ADODB.Recordset
    Dim rst As New ADODB.Recordset
    
    Dim firstRow As New Dictionary
    Dim k As Variant
    Set firstRow = data.Item(1)
'    For Each k In firstRow.Keys
'        rst.Fields.Append k, adVarChar, 50, adFldMayBeNull
'    Next
    rst.Fields.Append firstRow.Keys(0), adVarChar, 50, adFldKeyColumn
    rst.Fields.Append firstRow.Keys(1), adDouble
    rst.Fields.Append firstRow.Keys(2), adDouble
    rst.Fields.Append firstRow.Keys(3), adDouble
    rst.Fields.Append firstRow.Keys(4), adDouble
    rst.Fields.Append firstRow.Keys(5), adDouble
    rst.Fields.Append firstRow.Keys(6), adDouble
    
    rst.CursorType = adOpenKeyset
    rst.CursorLocation = adUseClient
    rst.LockType = adLockPessimistic
    
    Dim val As Dictionary
    Dim col As Integer
    
    ' 加載數(shù)據(jù)
    rst.Open
    For Each val In data
        rst.AddNew
        col = 0
        For Each k In val.Keys
            rst.Fields(col) = val(k)
            col = col + 1
        Next
        rst.Update
    Next
    
    Set DataToRecordSet = rst
End Function

注釋掉的代碼提供了更通用的功能蝙泼，但因?yàn)閿?shù)據(jù)類型無法確定，都默認(rèn)為 varchar劝枣，效果不好汤踏，就改為根據(jù)數(shù)據(jù)本身的類型來確定 RecordSet 字段的數(shù)據(jù)類型。

測試代碼如下舔腾。先編寫一個函數(shù)來獲取值：

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

然后再將數(shù)據(jù)導(dǎo)出到工作表：

Public Sub ExportDataTest()
    Dim rst As New ADODB.Recordset
    Set rst = StoneSAPFunctions.printModule.GetRecordSet
    
    ' print header
    Dim col As Integer
    For col = 0 To rst.Fields.Count - 1
        Sheet1.Range("A1").Offset(0, col) = rst.Fields(col).Name
    Next
    
    ' print line items
    rst.MoveFirst
    Sheet1.Range("A2").CopyFromRecordset rst
End Sub

在 CopyFromRecordset() 方法前溪胶，需要調(diào)用 Recordset 的 MoveFirst() 方法，否則游標(biāo)處在最后一行稳诚，只打印出最后一行哗脖。