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

* 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
 

posted on 2006-12-22 10:16  毛小娃  阅读(175)  评论(0编辑  收藏  举报

导航