************************************************************************
* 利用OLE将LIST中的数据输出到EXCEL工作表中
************************************************************************
INCLUDE OLE2INCL.
* 数据定义
DATA: H_EXCEL TYPE OLE2_OBJECT,        " Excel object
      H_MAPL TYPE OLE2_OBJECT,         " list of workbooks
      H_MAP TYPE OLE2_OBJECT,          " workbook
      H_ZL TYPE OLE2_OBJECT,           " cell
      H_F TYPE OLE2_OBJECT.            " font
DATA G_INFILE LIKE RLGRAP-FILENAME.
DATA G_DESKTOP(100).
DATA MSGTXT(50).

************************************************************************

*&---------------------------------------------------------------------*
*&      Form  NEW_SHEET
*&---------------------------------------------------------------------*
*       建立一个EXCEL工作表
*----------------------------------------------------------------------*

FORM FRM_NEWSHEET.
  CREATE OBJECT H_EXCEL 'EXCEL.APPLICATION'.
  PERFORM FRM_ERR_HDL.
  CALL METHOD OF H_EXCEL 'Workbooks' = H_MAPL.
  MSGTXT = '正在新建文件'.
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
     EXPORTING
           TEXT       = MSGTXT
       EXCEPTIONS
            OTHERS     = 1.
  PERFORM FRM_ERR_HDL.
  CALL METHOD OF H_MAPL 'Add' = H_MAP.
  PERFORM FRM_ERR_HDL.
ENDFORM.
*&---------------------------------------------------------------------*
*&      Form  FRM_SELSHEET
*&---------------------------------------------------------------------*
*       选择用于输出报表的模板文件
*----------------------------------------------------------------------*
FORM FRM_SELSHEET .
  CALL FUNCTION 'GUI_GET_DESKTOP_INFO'
    EXPORTING
      type   = 12
    CHANGING
      return = G_DESKTOP.
  CALL FUNCTION 'WS_FILENAME_GET'
       EXPORTING
            def_path         = G_DESKTOP
            mask             = ',Microsoft Excel 文件,*.XLS.'
            mode             = 'O'               "'O'就是打开 'S'就是保存
            title            = '打开文件'
       IMPORTING
            filename         = G_INFILE
       EXCEPTIONS
            inv_winsys       = 1
            no_batch         = 2
            selection_cancel = 3
            selection_error  = 4
            OTHERS           = 5.
   IF SY-SUBRC = 3.
     STOP.
   ENDIF.
  CREATE OBJECT H_EXCEL 'EXCEL.APPLICATION'.
  PERFORM FRM_ERR_HDL.
  CALL METHOD OF H_EXCEL 'Workbooks' = H_MAPL.
  MSGTXT = '正在打开文件'.
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
     EXPORTING
           TEXT       = MSGTXT
       EXCEPTIONS
            OTHERS     = 1.
  PERFORM FRM_ERR_HDL.
  CALL METHOD OF H_MAPL 'OPEN' = H_MAP EXPORTING #1 = G_INFILE.
  PERFORM FRM_ERR_HDL.
ENDFORM.                    " FRM_SELSHEET
*&---------------------------------------------------------------------*
*&      Form  FRM_SETWIDTH
*&---------------------------------------------------------------------*
*       设置EXCEL单元格宽度
*----------------------------------------------------------------------*
*  -->   COL      单元格列号
*  -->   WIDTH    单元格列宽
*----------------------------------------------------------------------*
FORM FRM_SETWIDTH USING COL WIDTH.
  CALL METHOD OF H_EXCEL 'Cells' = H_ZL EXPORTING #1 = 1 #2 = COL.
  PERFORM FRM_ERR_HDL.
  SET PROPERTY OF H_ZL 'ColumnWidth' = WIDTH.
  PERFORM FRM_ERR_HDL.
ENDFORM.
*&---------------------------------------------------------------------*
*&      Form  FRM_FILLCELL
*&---------------------------------------------------------------------*
*       将数据写入单元格
*----------------------------------------------------------------------*
*  -->   I        单元格行号
*  -->   J        单元格列号
*  -->   VAL      单元格值
*----------------------------------------------------------------------*
FORM FRM_FILLCELL USING I J VAL.
  CALL METHOD OF H_EXCEL 'Cells' = H_ZL EXPORTING #1 = I #2 = J.
  PERFORM FRM_ERR_HDL.
  DATA L_ROW(3).                       "单元格行
  DATA L_COL(3).                         "单元格列
  L_ROW   = I.
  L_COL   = J.
  CLEAR MSGTXT.
  CONCATENATE '正在写入单元格第' L_ROW '行,第' L_COL '列' INTO MSGTXT.
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
     EXPORTING
           TEXT       = MSGTXT
       EXCEPTIONS
            OTHERS     = 1.

  SET PROPERTY OF H_ZL 'Value' = VAL .
  PERFORM FRM_ERR_HDL.
ENDFORM.                    "FILL_CELL
*&---------------------------------------------------------------------*
*&      Form  FRM_FREESHEET
*&---------------------------------------------------------------------*
*       释放该EXCEL对象
*----------------------------------------------------------------------*

FORM FRM_FREESHEET.
  MSGTXT = '文件写入完毕'.
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
     EXPORTING
           TEXT       = MSGTXT
       EXCEPTIONS
            OTHERS     = 1.
  SET PROPERTY OF H_EXCEL  'Visible' = 1.
  PERFORM FRM_ERR_HDL.
  FREE OBJECT H_EXCEL.
  PERFORM FRM_ERR_HDL.
ENDFORM.                    "FREE_SHEET
*&---------------------------------------------------------------------*
*&      Form  FRM_ERR_HDL
*&---------------------------------------------------------------------*
*       显示出错信息并停止运行
*----------------------------------------------------------------------*

FORM FRM_ERR_HDL.
  IF SY-SUBRC <> 0.
    MESSAGE E001(ZDEV).
    PERFORM FRM_FREESHEET.
    STOP.
  ENDIF.
ENDFORM.                    " ERR_HDL

************************************************************************
* 利用OLE将LIST中的数据输出到EXCEL工作表中
************************************************************************

*&---------------------------------------------------------------------*
*&      Form FRM_GET_NAME
*&---------------------------------------------------------------------*
*       根据用户名,取得对应姓或名字
*----------------------------------------------------------------------*
*      -->L_CHAR(1)TYPE C.
*         如果是:'',那就取得姓,否则取得全名
*      -->L_NAME. 用户名
*      <--L_NAME LIKE ADRP-NAME_LAST 或 L_NAME LIKE ADRP-NAME_TEXT.
*----------------------------------------------------------------------*
FORM FRM_GET_NAME USING L_USER L_FLAG CHANGING L_NAME.
  IF L_FLAG = ''.
    SELECT ADRP~NAME_LAST
      INTO (L_NAME)
      FROM USR21 INNER JOIN ADRP ON USR21~PERSNUMBER = ADRP~PERSNUMBER
      WHERE USR21~BNAME = L_USER.
    ENDSELECT.
  ELSE.
    SELECT ADRP~NAME_TEXT
      INTO (L_NAME)
      FROM USR21 INNER JOIN ADRP ON USR21~PERSNUMBER = ADRP~PERSNUMBER
      WHERE USR21~BNAME = L_USER.
    ENDSELECT.
  ENDIF.
ENDFORM.

posted on 2009-06-01 09:09  沧海-重庆  阅读(542)  评论(1编辑  收藏  举报