SAP万能导出程序.docx
《SAP万能导出程序.docx》由会员分享，可在线阅读，更多相关《SAP万能导出程序.docx（24页珍藏版）》请在冰豆网上搜索。
SAP万能导出程序
SAP万能导出程序
——Author：
SUNZKQQ：
1131341075
REPORT YMPSRDOWNLOAD MESSAGE-ID YMTT.
INCLUDE OLE2INCL.
INCLUDE ZSD_TABLE_DOWNLOAD_TOP.
INCLUDE ZSD_TABLE_DOWNLOAD_SEL.
INCLUDE ZSD_TABLE_DOWNLOAD_F01. "BUSINESS LOGIC
START-OF-SELECTION.
CLEAR:
GV_RC,GV_MSG,TABLE_NAMES.
PERFORM GET_TABNAMES TABLES TABLE_NAMES.
PERFORM CHECK_DATA TABLES TABLE_NAMES CHANGING GV_RC GV_MSG.
IF GV_RC NE 0.
MESSAGE GV_MSG TYPE 'S' DISPLAY LIKE 'E'.
RETURN.
ENDIF.
IF P_FNAME IS NOT INITIAL.
GV_FILENAME = P_FNAME.
ENDIF.
CALL FUNCTION 'DOWNLOAD_TABLE'
EXPORTING
IM_VKORG = P_VKORG
IM_FULLNAME = GV_FILENAME
IMPORTING
E_RC = GV_RC
E_MSG = GV_MSG
TABLES
TABLE_NAMES = TABLE_NAMES.
TYPE-POOLS:
SLIS.
TABLES:
DD02T.
TYPES:
BEGIN OF TY_XSLP.
INCLUDE TYPE TVKOT.
TYPES:
END OF TY_XSLP.
DATA:
GT_VKORG TYPE STANDARD TABLE OF TY_XSLP,
GS_VKORG TYPE TY_XSLP.
DATA:
GT_DD02T TYPE TABLE OF DD02T,
GS_DD02T TYPE DD02T,
SHEETNAME（10） VALUE ' ',C_ROW TYPE I,
SCNT TYPE I,
VAL（20）, WB
（2）,VAL1（20）.
DATA:
EXCEL TYPE OLE2_OBJECT,
WORKBOOK TYPE OLE2_OBJECT,
SHEET TYPE OLE2_OBJECT,
CELL TYPE OLE2_OBJECT,
CELL1 TYPE OLE2_OBJECT,
COLUMN TYPE OLE2_OBJECT,
RANGE TYPE OLE2_OBJECT,
BORDERS TYPE OLE2_OBJECT,
BUTTON TYPE OLE2_OBJECT,
INT TYPE OLE2_OBJECT,
FONT TYPE OLE2_OBJECT,
ROW TYPE OLE2_OBJECT.
DATA:
APPLICATION TYPE OLE2_OBJECT,
BOOK TYPE OLE2_OBJECT,
BOOKS TYPE OLE2_OBJECT.
DATA:
OLE_BOOK TYPE OLE2_OBJECT.
CONSTANTS:
CNS_NUM TYPE N VALUE '1'.
DATA:
table_names TYPE STANDARD TABLE OF DD02L,
TABLE_NAME TYPE DD02L.
DATA:
GV_RC TYPE CHAR01,
GV_MSG TYPE CHAR255.
DATA:
GV_FILENAME TYPE STRING.
SELECTION-SCREEN BEGIN OF BLOCK blk_params WITH FRAME TITLE text-001.
PARAMETERS:
p_fname LIKE rlgrap-filename OBLIGATORY.
PARAMETERS:
p_vkorg LIKE gs_vkorg-vkorg.
SELECT-OPTIONS:
s_tab FOR dd02t-tabname NO INTERVALS.
SELECTION-SCREEN END OF BLOCK blk_params.
DATA:
fname LIKE p_fname.
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_fname.
PERFORM frm_f4_fname USING P_fname.
*&---------------------------------------------------------------------*
*& 包含 ZSD_TABLE_DOWNLOAD_F01
*&---------------------------------------------------------------------*
FORM CREATE_EXCEL .
CREATE OBJECT EXCEL 'EXCEL.APPLICATION'.
IF SY-SUBRC NE 0.
WRITE:
/ '没有EXCEL表格被创建！
'.
STOP.
ENDIF.
SET PROPERTY OF EXCEL 'DisplayAlerts' = 0.
CALL METHOD OF
EXCEL
'WORKBOOKS' = WORKBOOK.
** Put Excel in background
* IF p_exvis EQ 'X'.
* SET PROPERTY OF excel 'VISIBLE' = 1.
* ELSE.
* SET PROPERTY OF excel 'VISIBLE' = 0.
* ENDIF.
* Create worksheet
SET PROPERTY OF EXCEL 'SheetsInNewWorkbook' = 1.
CALL METHOD OF
WORKBOOK
'ADD'.
ENDFORM. " CREATE_EXCEL
*&---------------------------------------------------------------------*
*& Form SAVE_BOOK
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM SAVE_BOOK .
GET PROPERTY OF EXCEL 'ActiveSheet' = SHEET.
FREE OBJECT SHEET.
FREE OBJECT WORKBOOK.
GET PROPERTY OF EXCEL 'ActiveWorkbook' = WORKBOOK.
CALL METHOD OF
WORKBOOK
'SAVEAS'
EXPORTING
#1 = P_FNAME
#2 = 1.
CALL METHOD OF
WORKBOOK
'CLOSE'.
CALL METHOD OF
EXCEL
'QUIT'.
FREE OBJECT SHEET.
FREE OBJECT WORKBOOK.
FREE OBJECT EXCEL.
ENDFORM. " SAVE_BOOK
*&---------------------------------------------------------------------*
*& Form SHEET
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM SHEET .
DATA:
LV_NUM TYPE I, "记录创建几个SHEET
LS_TAB LIKE LINE OF S_TAB,
LT_DD02T TYPE TABLE OF DD02T,
LS_DD02T TYPE DD02T,
LV_TABNAME TYPE TABNAME.
REFRESH:
GT_DD02T,LT_DD02T.
CLEAR:
LV_NUM,LS_TAB,GS_DD02T.
IF S_TAB IS NOT INITIAL.
DESCRIBE TABLE S_TAB LINES LV_NUM.
ELSE.
MESSAGE S252 DISPLAY LIKE 'E'.
EXIT..
ENDIF.
SELECT * INTO CORRESPONDING FIELDS OF TABLE GT_DD02T
FROM DD02T.
LOOP AT S_TAB INTO LS_TAB.
READ TABLE GT_DD02T INTO GS_DD02T WITH KEY TABNAME = LS_TAB-LOW BINARY SEARCH.
IF SY-SUBRC = 0.
APPEND GS_DD02T TO LT_DD02T.
ENDIF.
ENDLOOP.
DO LV_NUM TIMES.
READ TABLE LT_DD02T INTO LS_DD02T INDEX 1.
IF SY-SUBRC = 0.
SHEETNAME = LS_DD02T-DDTEXT.
LV_TABNAME = LS_DD02T-TABNAME.
DELETE LT_DD02T WHERE TABNAME = LS_DD02T-TABNAME.
ENDIF.
IF SY-INDEX GT 1.
CALL METHOD OF
EXCEL
'WORKSHEETS' = SHEET.
CALL METHOD OF
SHEET
'ADD'.
FREE OBJECT SHEET.
ENDIF.
SCNT = 1.
CALL METHOD OF
EXCEL
'WORKSHEETS' = SHEET
EXPORTING
#1 = SCNT.
CALL METHOD OF
SHEET
'ACTIVATE'.
* SET PROPERTY OF SHEET 'NAME' = SHEETNAME.
SET PROPERTY OF SHEET 'NAME' = LV_TABNAME.
FREE OBJECT SHEET. "OK
PERFORM FILL_SHEET USING LV_TABNAME.
*
CALL METHOD OF
EXCEL
'Columns' = COLUMN.
CALL METHOD OF
COLUMN
'Autofit'.
FREE OBJECT COLUMN.
*
* call method of sheet 'BUTTON' = button.
* call method of button 'ADD'.
* set property of button 'fmButtonStyle' = 0.
* exporting #1 = '96.75' #2 = '372' #3 = '123.75' #4 = '12'.
* set property of button 'Characters' = 'ButtonTest'.
FREE OBJECT BUTTON.
FREE OBJECT FONT.
FREE OBJECT INT.
FREE OBJECT CELL.
FREE OBJECT:
CELL1.
FREE OBJECT RANGE.
FREE OBJECT BORDERS.
FREE OBJECT:
COLUMN, ROW.
ENDDO.
FREE OBJECT FONT.
FREE OBJECT INT.
FREE OBJECT CELL.
FREE OBJECT CELL1.
FREE OBJECT RANGE.
FREE OBJECT BORDERS.
FREE OBJECT COLUMN.
FREE OBJECT ROW.
FREE OBJECT SHEET.
ENDFORM. " SHEET
*---------------------------------------------------------------------*
* FORM border *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> we *
*---------------------------------------------------------------------*
FORM BORDER USING WE.
*left
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '1'.
SET PROPERTY OF BORDERS 'LineStyle' = '1'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE. "4=max
FREE OBJECT BORDERS.
* right
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '2'.
SET PROPERTY OF BORDERS 'LineStyle' = '2'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
FREE OBJECT BORDERS.
* top
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '3'.
SET PROPERTY OF BORDERS 'LineStyle' = '3'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
FREE OBJECT BORDERS.
* bottom
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '4'.
SET PROPERTY OF BORDERS 'LineStyle' = '4'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
* set property of borders 'ColorIndex' = 'xlAutomatic'.
FREE OBJECT BORDERS.
ENDFORM. "border
*---------------------------------------------------------------------*
* FORM border2 *
*---------------------------------------------------------------------*
* ........ *
*---------------------------------------------------------------------*
* --> we *
*---------------------------------------------------------------------*
FORM BORDER2 USING WE.
*left
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '1'.
SET PROPERTY OF BORDERS 'LineStyle' = '5'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE. "4=max
FREE OBJECT BORDERS.
* right
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '2'.
SET PROPERTY OF BORDERS 'LineStyle' = '6'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
FREE OBJECT BORDERS.
* top
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '3'.
SET PROPERTY OF BORDERS 'LineStyle' = '7'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
FREE OBJECT BORDERS.
* bottom
CALL METHOD OF
CELL
'BORDERS' = BORDERS
EXPORTING
#1 = '4'.
SET PROPERTY OF BORDERS 'LineStyle' = '8'.
SET PROPERTY OF BORDERS 'WEIGHT' = WE.
* set property of borders 'ColorIndex' = 'xlAutomatic'.
FREE OBJECT BORDERS.
ENDFORM. "border2
*---------------------------------------------------------------------*
* FORM border3 *
*---------------------------------------------------------------------*
* ........ *
*-----------------------------------------------------------
升级会员 