SAP 对法定的会计报表，比如资产负债表，损益表等，有多种实现方案。这里给出一个集成 Excel 的实现方案。实现方案的主要优点是用户的自由度比较大，可以灵活设置，而且基本实现了一次开发，不同项目只需要部署就能使用。
1. 资产负债表实现方法说明
- 在 Excel 中，使用 VBA 调用 SAP RFC 方法，导入公司代码下会计科目和科目汇总表 （英文叫 Trial balance, 包括会计科目的期初余额、本期发生额和期末余额），自动保存到 Excel 工作表，导入的数据格式如下:
数据字段说明：
- 在 Excel 中自定义相应函数，实现数据显示。比如我们要实现的 “资产负债表” 格式如下：
以【货币资金】为例，D7 单元格的公式：=AccAmount(BS_Source!B:B,K7,BS_Source!J:J)，AccAmount 是自定义的函数名，表示获取会计科目的期末余额。我们先不管这个函数参数是什么意思，总之是实现自动取数，文章后面会详细说明。
2. 数据通过 RFC 导入到 Excel
SAP 中自定义函数获取会计科目余额和发生额
SAP 提供的函数 BAPI_GL_GETGLACCPERIODBALANCES 只能提供单个科目的会计余额，我们要导入的是批量数据，所以需要自定义一个函数。写法可以多种，这里给出一个示例代码：
FUNCTION zbapi_getglaccperiodbalances.
*"----------------------------------------------------------------------
*"*"局部接口：
*" IMPORTING
*" VALUE(COMPANYCODE) LIKE FAGLFLEXT-RBUKRS OPTIONAL
*" VALUE(FISCALYEAR) LIKE FAGLFLEXT-RYEAR OPTIONAL
*" VALUE(PERIOD) LIKE FAGLFLEXT-RPMAX OPTIONAL
*" VALUE(CURRENCYTYPE) LIKE BAPI1028_5-CURR_TYPE OPTIONAL
*" EXPORTING
*" VALUE(BALANCE_CARRIED_FORWARD) LIKE BAPI1028_4-BALANCE
*" VALUE(RETURN) LIKE BAPIRETURN STRUCTURE BAPIRETURN
*" TABLES
*" ACCOUNT_BALANCES STRUCTURE ZBALANCES OPTIONAL
*" EXCEPTIONS
*" INIT_DATA
*"----------------------------------------------------------------------
DATA: BEGIN OF lt_fag OCCURS 0,
bukrs LIKE faglflext-rbukrs, "公司代码
ryear LIKE faglflext-ryear, "会计年度
racct LIKE faglflext-racct, "会计科目
drcrk LIKE faglflext-drcrk, "借贷方
hslvt LIKE faglflext-hslvt,
hsl01 LIKE faglflext-hsl01,
hsl02 LIKE faglflext-hsl02,
hsl03 LIKE faglflext-hsl03,
hsl04 LIKE faglflext-hsl04,
hsl05 LIKE faglflext-hsl05,
hsl06 LIKE faglflext-hsl06,
hsl07 LIKE faglflext-hsl07,
hsl08 LIKE faglflext-hsl08,
hsl09 LIKE faglflext-hsl09,
hsl10 LIKE faglflext-hsl10,
hsl11 LIKE faglflext-hsl11,
hsl12 LIKE faglflext-hsl12,
hsl13 LIKE faglflext-hsl13,
hsl14 LIKE faglflext-hsl14,
hsl15 LIKE faglflext-hsl15,
hsl16 LIKE faglflext-hsl16,
END OF lt_fag,
lt_ret LIKE zbalances OCCURS 0 WITH HEADER LINE.
FIELD-SYMBOLS: <field>.
DATA: lv_idx TYPE i,
lv_times TYPE i,
lv_int TYPE i,
lv_rpmax(2) TYPE c,
lv_fieldname TYPE string,
lv_hslxx LIKE faglflext-hslvt,
lv_waers LIKE t001-waers.
* 公司本位币
SELECT SINGLE waers
INTO lv_waers
FROM t001
WHERE bukrs = companycode.
SELECT rbukrs AS bukrs
ryear
racct
drcrk
hslvt
hsl01
hsl02
hsl03
hsl04
hsl05
hsl06
hsl07
hsl08
hsl09
hsl10
hsl11
hsl12
hsl13
hsl14
hsl15
hsl16
INTO TABLE lt_fag
FROM faglflext
WHERE rbukrs = companycode
and ryear = fiscalyear.
SORT lt_fag BY bukrs ryear racct drcrk.
LOOP AT lt_fag.
AT NEW racct.
CLEAR lt_ret.
lt_ret-comp_code = lt_fag-bukrs.
lt_ret-gl_account = lt_fag-racct.
lt_ret-fisc_year = lt_fag-ryear.
lt_ret-fis_period = period.
lt_ret-currency = lv_waers.
ENDAT.
* 年初余额
lt_ret-yr_begin_bal = lt_ret-yr_begin_bal + lt_fag-hslvt.
IF period = 12.
lv_times = 16.
ELSE.
lv_times = period.
ENDIF.
* 期初余额
lt_ret-per_begin_bal = lt_ret-per_begin_bal + lt_fag-hslvt.
lv_times = lv_times - 1.
DO lv_times TIMES.
IF sy-index >= lv_times.
EXIT.
ENDIF.
MOVE sy-index TO lv_rpmax.
SHIFT lv_rpmax RIGHT DELETING TRAILING space.
OVERLAY lv_rpmax WITH '00'.
CONCATENATE 'HSL' lv_rpmax INTO lv_fieldname.
ASSIGN COMPONENT lv_fieldname OF STRUCTURE lt_fag TO <field>.
MOVE <field> TO lv_hslxx.
lt_ret-per_begin_bal = lt_ret-per_begin_bal + lv_hslxx.
ENDDO.
IF period = 12.
lv_times = 5.
ELSE.
lv_times = 1.
ENDIF.
* 期间发生额
DO lv_times TIMES.
lv_int = period + sy-index - 1.
MOVE lv_int TO lv_rpmax.
SHIFT lv_rpmax RIGHT DELETING TRAILING space.
OVERLAY lv_rpmax WITH '00'.
CONCATENATE 'HSL' lv_rpmax INTO lv_fieldname.
ASSIGN COMPONENT lv_fieldname OF STRUCTURE lt_fag TO <field>.
MOVE <field> TO lv_hslxx.
IF lt_fag-drcrk = 'S'.
* 期间借方
lt_ret-debits_per = lt_ret-debits_per + lv_hslxx.
ELSE.
* 期间贷方
lt_ret-credit_per = lt_ret-credit_per + lv_hslxx.
ENDIF.
ENDDO.
AT END OF racct.
APPEND lt_ret.
ENDAT.
ENDLOOP.
LOOP AT lt_ret.
lv_idx = sy-tabix.
* 期间发生额（借方+贷方）
lt_ret-period_amt = lt_ret-debits_per + lt_ret-credit_per.
* 期末余额
lt_ret-balance = lt_ret-per_begin_bal + lt_ret-period_amt.
MODIFY lt_ret INDEX lv_idx.
ENDLOOP.
DELETE lt_ret WHERE yr_begin_bal = 0 AND per_begin_bal = 0 AND debits_per = 0 AND credit_per = 0.
account_balances[] = lt_ret[].
ENDFUNCTION.
函数名： zbapi_getglaccperiodbalances。函数的参数包括公司代码，年度，期间，币别，根据参数所确定的条件，输出这些科目的期初余额，本期发生额，期末余额。代码简单，不多解释，也不是本文的重点。但顺便提一句，SAP 系统 ABAP 的编码就这么多，不像其他解决方案，可能需要大量 ABAP 编码。
RFC SAP_Connection 模块
从模块的角度给出代码。Excel 首先是SAP_Connection模块，负责连接 SAP 系统，登陆 (Logon) 和注销 (Logoff) 。
' 模块说明：
' 负责SAP的连接，连接成功后，SAPConnection对象保存连接的信息
Option Explicit
Dim sapLogon As SAPLogonCtrl.SAPLogonControl
Public SAPConnection As SAPLogonCtrl.Connection
Public logonSuccessful As Boolean
Public Sub logon()
logonSuccessful = False
Set sapLogon = New SAPLogonControl
Set SAPConnection = sapLogon.NewConnection()
Call SAPConnection.logon(0, False)
If SAPConnection.IsConnected = tloRfcConnected Then
logonSuccessful = True
Exit Sub
End If
End Sub
Public Sub Logoff()
If SAPConnection Is Nothing Then
Exit Sub
End If
SAPConnection.Logoff
logonSuccessful = False
Set SAPConnection = Nothing
End Sub
RFC 调用 函数 zbapi_getglaccperiodbalances
调用 SAP zbapi_getglaccperiodbalances 函数，将数据写入工作表。
首先在 VBA 中实现 ABAP内表数据（函数的表参数）写入工作表的通用实现。考虑到代码效率，数据先在内存中处理后，一次性写到工作表：
' 模块说明：
' SAP FM的表参数类似internal table, 将数据输出值EXCEL工作表
Option Explicit
'--------------------------------------------------
' 将Table对象写入worksheet, 整体拷贝，速度优化
'--------------------------------------------------
Public Sub WriteTable(itab As SAPTableFactoryCtrl.Table, sht As Worksheet)
Dim col As Long ' column index
Dim row As Long ' row index
Dim headerRange As Variant '在Excel中根据itab的header大小，类型为Variant数组
Dim itemsRange As Variant '在Excel中根据itab的行数和列数，类型为Variant数组
' 清除cells的内容
sht.Cells.ClearContents
If itab.RowCount = 0 Then
Exit Sub
End If
'-------------------------------------------------
' 取消Excel的屏幕刷新和计算功能以加快速度
'-------------------------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'------------------------------
' 将Table的Header写入Worksheet
'------------------------------
' 根据内表的列数，使用Range创建一个数组
Dim headerstarts As Range
Dim headerends As Range
Set headerstarts = sht.Cells(1, 1)
Set headerends = sht.Cells(1, itab.ColumnCount)
headerRange = sht.Range(headerstarts, headerends).Value
' 将内表列名写入数组
For col = 1 To itab.ColumnCount
headerRange(1, col) = itab.Columns(col).Name
Next
' 从数组一次性写入Excel，这样效率较高
sht.Range(headerstarts, headerends).Value = headerRange
'-------------------------------
' 将Table的行项目写入Worksheet
'-------------------------------
' 根据内表的大小,使用Range创建数组
Dim itemStarts As Range
Dim itemEnds As Range
Set itemStarts = sht.Cells(2, 1)
Set itemEnds = sht.Cells(itab.RowCount + 1, itab.ColumnCount)
itemsRange = itab.Data
' 一次性将数组写入Worksheet
sht.Range(itemStarts, itemEnds).Value = itemsRange
'---------------------------------
' 恢复Excel的屏幕刷新和计算
'---------------------------------
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub
然后是调用 zbapi_getglaccperiodbalances 函数，代码在sap_get_acc_period_bal模块：
' 模块说明：
' 调用RFC获取公司代码会计科目的余额，写入工作表
'
' v1.0, 2015-6-14 by Stone Wang
' V1.1, 2015-6-26 by Stone Wang
Option Explicit
Public Sub get_sap_acc_balances(cocd As String, fiscal_yr As String, period As String)
' 导入SAP科目余额，写入BS_Source工作表
Dim sapFunctions As SAPFunctionsOCX.sapFunctions
Dim sapFunction As Object
Dim acBalanceTable As Object
' 写入的工作表
Dim sht As Worksheet
Set sht = BSSource
If logonSuccessful = False Then Exit Sub
Set sapFunctions = CreateObject("SAP.FUNCTIONS") ' Use function to call BAPI
Set sapFunctions.Connection = SAPConnection
On Error GoTo err1:
Set sapFunction = sapFunctions.Add("ZBAPI_GETGLACCPERIODBALANCES")
' Function import parameters
sapFunction.Exports("COMPANYCODE").Value = cocd 'Company code
sapFunction.Exports("FISCALYEAR").Value = fiscal_yr 'Fiscal year
sapFunction.Exports("PERIOD").Value = period
sapFunction.Exports("CURRENCYTYPE").Value = "10" 'Currency type
' Function table parameters
Set acBalanceTable = sapFunction.Tables("ACCOUNT_BALANCES")
If sapFunction.Call = True Then
If acBalanceTable.RowCount > 0 Then
sht.Activate
'将internal table写入工作表
Call WriteTable(acBalanceTable, sht)
Else
sht.Activate
sht.Cells.ClearContents
sht.Range("A1").Value = "没有数据被导入，数据源可能为空!"
End If
End If
Set acBalanceTable = Nothing
Set sapFunctions = Nothing
Set sapFunction = Nothing
err1:
If Err.Number = 1001 Then
MsgBox "远程调用错误，请检查SAP中是否存在函数ZBAPI_GETGLACCPERIODBALANCES，是否允许远程调用等。", _
vbExclamation
Exit Sub
End If
End Sub
另外，因为 Excel 自定义函数需要用到会计科目，从速度上考虑，把会计科目列表存放在一个工作表中，方便后续函数调用。会计科目列表调用
SAP 的 BAPI 来实现，这里直接从刚才导入的会计科目余额中提取，代码放在 account_gl_list模块 中：
' 模块说明：
' 从COASheet工作表获取公司代码下所有的会计科目清单
' 在UDF中，需要在会计科目的范围中循环，根据公司代码的科目清单，目的是提高效率
Option Explicit
Public Sub Generate_GL_List()
' 根据BS_Source的科目，产生会计科目清单，剔除重复项（如果有的话）
' 数据存放在GLList工作表中
Dim row_count As Integer
row_count = BSSource.UsedRange.rows.count
' 如果没有数据，则不处理
If row_count <= 1 Then Exit Sub
With GLListSheet
' 清除之前的数据
.Cells.ClearContents
' 数据拷贝
.Range("A1:A" & row_count + 1).Value = BSSource.Range("B1:B" & row_count + 1).Value
' 消除重复项
.Range("A:A").RemoveDuplicates
' 根据会计科目排序
.Columns("A:A").Sort key1:=.Range("A:A"), order1:=xlAscending, Header:=xlYes
End With
End Sub
Public Function get_gl_count() As Integer
'------------------------------------------
' 获取会计科目的数量
' 会计科目根据BS_Source导入的数据加工而得
'------------------------------------------
Dim count As Integer
'因为有表头，实际的会计科目数减一
count = GLListSheet.UsedRange.rows.count - 1
get_gl_count = count
End Function
用户操作界面设计
使用一个Excel工作表作为录入界面，执行上面的会计科目余额导入程序。
导入数据
当用点击【更新数据源】按钮，执行下面的代码，导入会计科目余额，至此，跟 SAP 数据交互完成。
' 模块说明：
' 从SAP系统导入会计科目余额
' Version 1.0, 2015-6-14 by Stone Wang
Option Explicit
Public Sub import_sap_data()
' 校验（input validation)
If Range("COMPANY_CODE").Value = "" Then
MsgBox "请输入公司代码.", vbExclamation
Exit Sub
End If
If Range("FISCAL_YEAR").Value = "" Then
MsgBox "请输入会计年度.", vbExclamation
Exit Sub
End If
If Range("PERIOD").Value = "" Then
MsgBox "请输入会计期间.", vbExclamation
Exit Sub
End If
' 如果没有连接到SAP，连接SAP
If logonSuccessful <> True Then
Call logon
End If
' 导入会计科目余额
Dim cocd As String
Dim fiscal_year As String
Dim period As String
cocd = CStr(Range("COMPANY_CODE").Value)
fiscal_year = CStr(Range("FISCAL_YEAR").Value)
period = CStr(Range("PERIOD").Value)
Call get_sap_acc_balances(cocd, fiscal_year, period)
' 根据BS_Source产生科目清单
' 将会计科目清单写入GLList工作表
Call Generate_GL_List
Application.Calculate
End Sub
3. Excel 自定义函数
我打算自定义的函数叫做 AccAmount，是对 Excel SumIfs 函数的包装和功能增强。
SumIfs 函数的语法大体如下：
SumIfs(rangeA, criteria, rangeB)
根据criteria（条件），在rangeA中找到相同的数据，然后将rangeB中对应行的数据加总，并作为返回值。
增强的原因是使用 SumIfs 函数，只能处理一个科目，因为资产负债表每个数据项可能来自多个科目，所以需要对这个函数进行修改，使得能处理多个科目。
我对资产负债表的数据项数据来源，定义了一种范围表达的格式。在科目范围中，用【分号】表示分隔的科目，用【…】表示连接的科目。举例如下：
- 1001000000..1099999999：表示 1001 开头的科目，即 1001000000 至
1099999999
- 2241000000..2241999999;2703000000..2703999999：表示2241开头的科目以及2703开头的科目
有了这个定义格式，我们就实现 AccAmount() 函数：
AccAmount(rangeA, accCriteria, rangeB)
根据 accCriteria（会计科目条件）在 rangeA 中找到对应科目，然后将rangeB 中对应行的单元格数据加总，并将汇总的数据作为返回值。
科目范围分解为会计科目数组
刚才所述的会计科目范围，我们需要将其分解为单个的科目，存放在数组中，代码放在 account_split 模块之中：
'模块说明：
'会计科目的范围用分号表示不连续的范围，用..表示连续的范围
'会计科目范围分解出具体的会计科目，先根据分号分割，再从连续的科目中分解
'为了提高效率，循环的时候，读取公司代码的实际科目清单
' Verion 1.1:
' Account_resolution函数增加了对输入参数为空的判断
Option Explicit
Private Function split_account_by_semicolon(account_range As String) As String()
'-------------------------------------------
' 将科目范围根据"分号"分解，然后放在数组中
' 数组中每一个item, 可能是单个科目，也可能是多个科目
'-------------------------------------------
Dim acc_array() As String
acc_array = Split(account_range, ";") ' split函数返回的数组从0开始
' 逗号分割的每一个数组元素前后可能存在空格，将空格去掉
Dim i As Integer
For i = LBound(acc_array) To UBound(acc_array)
acc_array(i) = Trim(CStr(acc_array(i)))
Next
split_account_by_semicolon = acc_array
End Function
Private Function split_continous_account(continous_acc As String) As String()
'将会计科目根据..进行分解
'..表示连续的科目范围
'如果有.., 但未找到合适科目，返回#EmptyForXXX#
'acc_count: 会计科目数量
Dim acc_count As Integer
acc_count = get_gl_count()
Dim acc_list() As String
If acc_count >= 1 Then
ReDim acc_list(1 To acc_count)
Else
ReDim acc_list(1 To 1)
End If
Dim dot_pos As Integer ' position of double dots 双点的位置
dot_pos = InStr(continous_acc, "..") ' 查找 ".." ，返回位置
Dim lower_acc As String
Dim upper_acc As String
' 一共需要处理三种情况：
' 1) 有..号，有科目被选择
' 2) 有..号，没有科目被选择
' 3) 没有..号，表示单个科目
If dot_pos > 0 Then ' Found
lower_acc = Left(continous_acc, dot_pos - 1)
upper_acc = Right(continous_acc, Len(continous_acc) - dot_pos - 1)
Dim account_range As Range
Set account_range = GLListSheet.Range("A2:A" & acc_count + 1)
Dim i As Integer
Dim item As Variant
Dim temp_acc As String
i = 1 ' cocd_coa下标从1开始
For Each item In account_range
temp_acc = CStr(item)
If temp_acc >= lower_acc And temp_acc <= upper_acc Then
acc_list(i) = CStr(item)
i = i + 1
End If
' 确保会计科目表示按科目大小排序的
If temp_acc > upper_acc Then
Exit For
End If
Next
If i > 1 Then ' i > 1表示有科目包括在其中
ReDim Preserve acc_list(1 To i - 1)
Else ' 表示没有科目被选择
ReDim Preserve acc_list(1 To 1)
acc_list(1) = "#EmptyFor" & continous_acc & "#" ' 没有找到科目,empty错误
End If
Else
ReDim acc_list(1 To 1)
acc_list(1) = continous_acc
End If
split_continous_account = acc_list
End Function
Public Function accounts_resolution(acc_range As String) As String()
'----------------------------------------------------
' 根据科目范围，将范围分解为单个会计科目，放在数组中
'----------------------------------------------------
' account_array()表示所有范围内科目，函数最后作为返回值
Dim account_array() As String
' 先判断参数acc_range是否为空
If Len(acc_range) = 0 Then
ReDim account_array(1 To 1)
account_array(1) = "#Empty#"
accounts_resolution = account_array
Exit Function
End If
' 如果参数acc_range不为空，正常处理
Dim count As Integer
count = get_gl_count()
If count > 1 Then
ReDim account_array(1 To count)
Else
ReDim account_array(1 To 1)
End If
' 先根据分号进行分解，分解后每一项表示单一科目或连续的科目
Dim continous_acc() As String
continous_acc = split_account_by_semicolon(acc_range)
Dim i As Integer
i = 1
Dim item As Variant
For Each item In continous_acc
' 再将连续的科目分解为具体的会计科目
Dim acc_in_continuous_rng() As String
acc_in_continuous_rng = split_continous_account(CStr(item))
Dim acc As Variant
For Each acc In acc_in_continuous_rng
account_array(i) = CStr(acc)
i = i + 1
Next
Next
' split_continuous_account()至少返回一个值
' 没有分解成功返回：#EmptyForXXX#, i的值一定会>=2, 所以不用判断i的大小
ReDim Preserve account_array(1 To i - 1)
accounts_resolution = account_array
End Function
代码说明
split_account_by_semicolon函数，用于将科目范围中 有分号 的分解，并存放在一个数组之中split_continous_account函数，用于将连续的科目分解，结果存放在数组中accounts_resolution函数，综合上面的两个函数，对科目范围进行分解，并将结果存放在数组中
定义 AccAmount 函数
将会计科目范围中的科目，循环调用 SumIfs 函数，结果加总，并作为返回值。
' @Author: Stone Wang
' @version 1.0
' @date: 2015-6-14
'
' 模块说明：
' 自定义函数，获取科目在某一列的合计，该函数是对EXCEL SUMIFs函数的增强
Option Explicit
Public Function AccAmount(ByVal acc_range As Range, _
ByVal acc_criteria As String, _
ByVal sum_range As Range) As Double
' 获取account期间的余额
' acc_range: account range
' acc_criteria: account criteria
' sum_range: sum range
Dim result As Double
Dim acc_array() As String
acc_array = accounts_resolution(acc_criteria)
Dim item As Variant
Dim current_acc As String
For Each item In acc_array
current_acc = CStr(item)
If Len(current_acc) > 0 Then
result = result + _
WorksheetFunction.SumIfs(sum_range, acc_range, current_acc)
End If
Next
AccAmount = result
End Function
AccAmount 函数使用方法说明
设置专门的数据源定义区，比如货币资金，设置科目范围如下：
并且将 1001000000…1099999999 所在的单元格定义一个名称为 CASH，这样在资产负债表的货币资金行中，使用如下公式：
=AccAmount(BS_Source!B:B,CASH,BS_Source!J:J)
表示根据 CASH 单元格的科目范围（即 1001000000 至 1099999999），从 BS_Source 工作表的 B 列找到科目范围中有的科目，将相应行的 J 列数据汇总。
这样，定义了所有科目的公式之后，资产负债表就做好了。因为函数是给用户使用的，用户可以自由定义报表的各种细节，灵活性就非常好，自动化程度也高。
我曾在两个 SAP 实施项目中使用了这种方法来实现资产负债表、损益表和现金流量表。如果用户接受 Excel 作为数据展示的平台，我们可以用这个思路实现很多报表。
扫一扫
634
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
