一个现金流量表的代码

最新推荐文章于 2024-04-14 21:37:28 发布

JLBOY

最新推荐文章于 2024-04-14 21:37:28 发布

阅读量784

点赞数

* 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
*----------------------------------------------------------------------*
*      -->P_I        text
*      -->P_J        text
*      -->P_VAL      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