SAP資產負債表實現方案探索 - 基于 VBA 自定義函數方法

本篇接著SAP資產負債表實現方案探索 - 基于 Excel-DNA 自定義函數方法
這篇博文，繼續(xù)介紹通過 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）發(fā)送和接收 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 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

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

使用加載宏中的自定義函數

打開一個新的 Excel 工作簿，切換到「開發(fā)工具」頁簽，點擊「Excel加載項」


從彈出對話框中選擇合適的加載宏，如果加載宏不在默認位置，點擊瀏覽按鈕選擇目標文件。


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


image

Restful Service 加載到 Excel 的方法

在寫上面函數的時候，發(fā)現 VBA 在調試 Dictionary 或者 Collection 的時候挺不直觀的，為了方便自己查看數據，就想著將數據導出到 Excel 工作表中。數據導出大體可以用兩種方法。

方法一：將解析后的 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

方法二：將數據加載到 ADODB.RecordSet，利用 VBA 中 Excel Range 提供的 CopyFromRecordSet() 將數據導入 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
    
    ' 加載數據
    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

注釋掉的代碼提供了更通用的功能，但因為數據類型無法確定，都默認為 varchar，效果不好，就改為根據數據本身的類型來確定 RecordSet 字段的數據類型。

測試代碼如下。 先編寫一個函數來獲取值：

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

然后再將數據導出到工作表：

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() 方法前，需要調用 Recordset 的 MoveFirst() 方法，否則游標處在最后一行，只打印出最后一行。

最后編輯于 ：
?著作權歸作者所有,轉載或內容合作請聯系作者
【社區(qū)內容提示】社區(qū)部分內容疑似由AI輔助生成，瀏覽時請結合常識與多方信息審慎甄別。
平臺聲明：文章內容（如有圖片或視頻亦包括在內）由作者上傳并發(fā)布，文章內容僅代表作者本人觀點，簡書系信息發(fā)布平臺，僅提供信息存儲服務。

友情鏈接更多精彩內容