一个现金流量表的代码,感谢琛(290911233)提供。

2006年12月22日 10:16:00

* program SOURCE HEADER : 现金流量表
* Program Name:
* Description:
* Date/Author:
* Table Update:
* Special Logic:
* Include:
*-----------------------------------------------------------------------
* MODIFICATION LOG : 程序修改更新记录
*-----------------------------------------------------------------------
* ChangeDate Programmer Request Description
* ========== ============= ============ ================================
*-----------------------------------------------------------------------
* REPORT NAME : 宣告程序名称及报表格式,
*-----------------------------------------------------------------------
REPORT ZFI003
NO STANDARD PAGE HEADING
MESSAGE-ID 00 "所使用的MESSAGE
LINE-COUNT 800 " 每页报表行数
LINE-SIZE 180. " 每页报表宽度
*-----------------------------------------------------------------------

* TABLE DESCRIPTION : 宣告程序会使用的TABLE
*-----------------------------------------------------------------------
TABLES: BSEG,BKPF,GLT0.
*-----------------------------------------------------------------------
* DATA : 宣告程序所使用的变量及自定型态
INCLUDE OLE2INCL. " FOR OLE
DATA: EXCEL TYPE OLE2_OBJECT,
BOOKS TYPE OLE2_OBJECT,
SHEET TYPE OLE2_OBJECT,
CELL TYPE OLE2_OBJECT.
*-----------------------------------------------------------------------
DATA: BEGIN OF ITAB_BKPF OCCURS 0 ,
BELNR LIKE BKPF-BELNR, "表头-凭证号
END OF ITAB_BKPF.

DATA: BEGIN OF ITAB_TT OCCURS 0 ,
BELNR LIKE BSEG-BELNR, "凭证号
HKONT LIKE BSEG-HKONT, "表体-总分类帐目
RSTGR LIKE BSEG-RSTGR, "REASON CODE
SHKZG LIKE BSEG-SHKZG, "debit and credit
DMBTR LIKE BSEG-DMBTR, "本位币金额
END OF ITAB_TT.

DATA: D01 LIKE BSEG-DMBTR,
D02 LIKE BSEG-DMBTR,
D03 LIKE BSEG-DMBTR,
D04 LIKE BSEG-DMBTR,
D05 LIKE BSEG-DMBTR,
D06 LIKE BSEG-DMBTR,
D07 LIKE BSEG-DMBTR,
D08 LIKE BSEG-DMBTR,
D09 LIKE BSEG-DMBTR,
D10 LIKE BSEG-DMBTR,
D11 LIKE BSEG-DMBTR,
D12 LIKE BSEG-DMBTR,
D13 LIKE BSEG-DMBTR,
D14 LIKE BSEG-DMBTR,
D15 LIKE BSEG-DMBTR,
D16 LIKE BSEG-DMBTR,
D17 LIKE BSEG-DMBTR,
D18 LIKE BSEG-DMBTR,
D19 LIKE BSEG-DMBTR,
D20 LIKE BSEG-DMBTR,
D21 LIKE BSEG-DMBTR,
D22 LIKE BSEG-DMBTR,
D23 LIKE BSEG-DMBTR,
D24 LIKE BSEG-DMBTR,
D25 LIKE BSEG-DMBTR,
D26 LIKE BSEG-DMBTR,
D27 LIKE BSEG-DMBTR,
D28 LIKE BSEG-DMBTR,
D29 LIKE BSEG-DMBTR,
D30 LIKE BSEG-DMBTR,
D31 LIKE BSEG-DMBTR.


**----------------------------------------------------------------------
** SELECTION SCREEN / OPTION / PARAMETER :
*屏幕输入报表筛选条件
**----------------------------------------------------------------------
SELECTION-SCREEN BEGIN OF BLOCK BL01 WITH FRAME TITLE TEXT-001.
*PARAMETERS: p_bukrs LIKE glt0-bukrs OBLIGATORY DEFAULT '1000'.
SELECT-OPTIONS: P_BUKRS FOR GLT0-BUKRS OBLIGATORY DEFAULT '1000'.
SELECT-OPTIONS: S_GJAHR FOR BKPF-GJAHR OBLIGATORY DEFAULT SY-DATUM(4),
S_MONAT FOR BKPF-MONAT DEFAULT SY-DATUM+4(2).
SELECTION-SCREEN END OF BLOCK BL01.

SELECTION-SCREEN BEGIN OF BLOCK BLK2 WITH FRAME TITLE TEXT-001.
PARAMETERS : P_FNAME(60) DEFAULT 'C:/SAP/CASH.XLS'.
SELECTION-SCREEN END OF BLOCK BLK2.
*----------------------------------------------------------------------
* AT SELECTION-SCREEN :
*将要离开选择屏幕的时候执行的事件,可以检查输入
*----------------------------------------------------------------------
*AT SELECTION-SCREEN.
* IF S_MONAT-HIGH IS INITIAL.
* MESSAGE E398 WITH '请输入过帐期间的上限!'.
* ENDIF.
*----------------------------------------------------------------------
* AT START SELECTION : 输入结束后启动的区块,
*如按下>F8<
*----------------------------------------------------------------------
START-OF-SELECTION.
DATA: L_EXIST.
CALL FUNCTION 'TMP_GUI_GET_FILE_EXIST'
EXPORTING
FNAME = P_FNAME
IMPORTING
EXIST = L_EXIST
* ISDIR =
* FILESIZE =
EXCEPTIONS
FILEINFO_ERROR = 1
OTHERS = 2 .
IF SY-SUBRC >< 0 OR L_EXIST >< 'X'. "SY-SUBRC返回代码值0 表示操作成功
MESSAGE I398(00) WITH '打开模版文件' P_FNAME '时出错!'.
EXIT.
ENDIF.
PERFORM READ_DATA.
*----------------------------------------------------------------------
* END OF SELECTION : 在结束打印数据后启动,
*如可用来印出USER输入的条件
*-----------------------------------------------------------------------
END-OF-SELECTION.
PERFORM WRITE_BS.
* FORM : 撰写程序中所使用到的子程序
*-----------------------------------------------------------------------
* Read Data : 自TABLE读取数据放入Internal Table
*-----------------------------------------------------------------------
FORM READ_DATA.

SELECT
BELNR "表头-凭证号
INTO CORRESPONDING FIELDS OF TABLE ITAB_BKPF
FROM BKPF
WHERE GJAHR IN S_GJAHR
AND MONAT IN S_MONAT
AND BUKRS IN P_BUKRS.
SELECT
HKONT "表体-总分类帐目
RSTGR "REASON CODE
SHKZG "debit and credit
BELNR "表头-凭证号
DMBTR "本位币金额
INTO CORRESPONDING FIELDS OF TABLE ITAB_TT
FROM BSEG
WHERE GJAHR IN S_GJAHR
AND BUKRS IN P_BUKRS
AND HKONT >= '0010090600'.
LOOP AT ITAB_TT.
READ TABLE ITAB_BKPF WITH KEY BELNR = ITAB_TT-BELNR.
IF SY-SUBRC >< 0.
DELETE ITAB_TT.
ENDIF.
ENDLOOP.
FREE ITAB_BKPF.
LOOP AT ITAB_TT.
CASE ITAB_TT-RSTGR.
WHEN '01'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D01 = D01 + ITAB_TT-DMBTR.
WHEN '02'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D02 = D02 + ITAB_TT-DMBTR.
WHEN '03'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D03 = D03 + ITAB_TT-DMBTR.
WHEN '04'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D05 = D05 + ITAB_TT-DMBTR.
WHEN '05'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D06 = D06 + ITAB_TT-DMBTR.
WHEN '06'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D07 = D07 + ITAB_TT-DMBTR.
WHEN '07'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D08 = D08 + ITAB_TT-DMBTR.
WHEN '08'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D11 = D11 + ITAB_TT-DMBTR.
WHEN '09'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D12 = D12 + ITAB_TT-DMBTR.
WHEN '10'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D13 = D13 + ITAB_TT-DMBTR.
WHEN '11'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D14 = D14 + ITAB_TT-DMBTR.
WHEN '12'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D16 = D16 + ITAB_TT-DMBTR.
WHEN '13'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D17 = D17 + ITAB_TT-DMBTR.
WHEN '14'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D18 = D18 + ITAB_TT-DMBTR.
WHEN '15'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D21 = D21 + ITAB_TT-DMBTR.
WHEN '16'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D22 = D22 + ITAB_TT-DMBTR.
WHEN '17'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D23 = D23 + ITAB_TT-DMBTR.
WHEN '18'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D25 = D25 + ITAB_TT-DMBTR.
WHEN '19'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D26 = D26 + ITAB_TT-DMBTR.
WHEN '20'.
IF ITAB_TT-SHKZG = 'S'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D27 = D27 + ITAB_TT-DMBTR.
WHEN '21'.
IF ITAB_TT-SHKZG = 'H'.
ITAB_TT-DMBTR = 0 - ITAB_TT-DMBTR.
ENDIF.
D30 = D30 + ITAB_TT-DMBTR.
ENDCASE.
ENDLOOP.

* D05 = ABS( D05 ).
* D06 = ABS( D06 ).
* D07 = ABS( D07 ).
* D08 = ABS( D08 ).
* D16 = ABS( D16 ).
* D17 = ABS( D17 ).
* D18 = ABS( D18 ).
* D25 = ABS( D25 ).
* D26 = ABS( D26 ).
* D27 = ABS( D27 ).

D04 = D01 + D02 + D03.
D09 = D05 + D06 + D07 + D08.
D10 = D04 - D09.
D15 = D11 + D12 + D13 + D14.
D19 = D16 + D17 + D18.
D20 = D15 - D19.
D24 = D21 + D22 + D23.
D28 = D25 + D26 + D27.
D29 = D24 - D28.
D31 = D10 + D20 + D29 + D30.
ENDFORM. "READ_DATA


*&---------------------------------------------------------------------*
*& Form write_bs
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM WRITE_BS.
CREATE OBJECT EXCEL 'EXCEL.APPLICATION'.
CALL METHOD OF EXCEL 'WORKBOOKS' = BOOKS.
CALL METHOD OF BOOKS 'OPEN'
EXPORTING #1 = P_FNAME . "'C:/CASH.XLS'.
CALL METHOD OF EXCEL 'WORKSHEETS' = SHEET EXPORTING #1 = 1.
CALL METHOD OF SHEET 'ACTIVATE'.
CALL METHOD OF EXCEL 'CELLS' = CELL EXPORTING #1 = 1 #2 = 1.

PERFORM FILL_CELL USING 6 3 D01.
PERFORM FILL_CELL USING 7 3 D02.
PERFORM FILL_CELL USING 8 3 D03.
PERFORM FILL_CELL USING 9 3 D04.
PERFORM FILL_CELL USING 10 3 D05.
PERFORM FILL_CELL USING 11 3 D06.
PERFORM FILL_CELL USING 12 3 D07.
PERFORM FILL_CELL USING 13 3 D08.
PERFORM FILL_CELL USING 14 3 D09.
PERFORM FILL_CELL USING 15 3 D10.
PERFORM FILL_CELL USING 17 3 D11.
PERFORM FILL_CELL USING 18 3 D12.
PERFORM FILL_CELL USING 19 3 D13.
PERFORM FILL_CELL USING 20 3 D14.
PERFORM FILL_CELL USING 21 3 D15.
PERFORM FILL_CELL USING 22 3 D16.
PERFORM FILL_CELL USING 23 3 D17.
PERFORM FILL_CELL USING 24 3 D18.
PERFORM FILL_CELL USING 25 3 D19.
PERFORM FILL_CELL USING 26 3 D20.
PERFORM FILL_CELL USING 28 3 D21.
PERFORM FILL_CELL USING 29 3 D22.
PERFORM FILL_CELL USING 30 3 D23.
PERFORM FILL_CELL USING 31 3 D24.
PERFORM FILL_CELL USING 32 3 D25.
PERFORM FILL_CELL USING 33 3 D26.
PERFORM FILL_CELL USING 34 3 D27.
PERFORM FILL_CELL USING 35 3 D28.
PERFORM FILL_CELL USING 36 3 D29.
PERFORM FILL_CELL USING 37 3 D30.
PERFORM FILL_CELL USING 38 3 D31.
PERFORM FILL_CELL USING 39 3 S_MONAT.

SET PROPERTY OF EXCEL 'Visible' = 1.

ENDFORM. "fill_cell
*&---------------------------------------------------------------------*
*& Form fill_cell
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -- * -- * -- *----------------------------------------------------------------------*
FORM FILL_CELL USING P_I
P_J
P_VAL.
CALL METHOD OF EXCEL 'CELLS' = CELL EXPORTING #1 = P_I #2 = P_J.
SET PROPERTY OF CELL 'VALUE' = P_VAL.

ENDFORM. " FILL_CELL



Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=1452792


  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值