FUNCTION Y96_LIST_TO_EXCEL_REG_CALLBACK.
*"----------------------------------------------------------------------
*"*"Local interface:
*" IMPORTING
*" VALUE(MAINPROG) LIKE SY-CPROG OPTIONAL
*" VALUE(EXT) TYPE C DEFAULT 'X'
*" VALUE(PROGRAM) LIKE SY-REPID OPTIONAL
*" VALUE(ON_START) OPTIONAL
*" VALUE(ON_CELL_BASE) OPTIONAL
*" VALUE(ON_ROW_BASE) OPTIONAL
*" VALUE(ON_CELL) OPTIONAL
*" VALUE(ON_ROW) OPTIONAL
*" VALUE(ON_TAG) OPTIONAL
*" VALUE(ON_COL_WIDTH) OPTIONAL
*" VALUE(ON_EXCEL) OPTIONAL
*" VALUE(ON_CONFIRM) OPTIONAL
*" VALUE(ON_CONFIRM_PBO) OPTIONAL
*"----------------------------------------------------------------------
* Пример исползования см. Y96TEST_LIST_TO_EXCEL_EXT
PERFORM INIT.
EVENT-PROGRAM = PROGRAM.
IF EVENT-PROGRAM IS INITIAL.
CALL 'AB_GET_CALLER' ID 'PROGRAM' FIELD EVENT-PROGRAM.
ENDIF.
CHECK NOT EVENT-PROGRAM IS INITIAL.
EVENT-ON_START = ON_START.
EVENT-ON_CELL_BASE = ON_CELL_BASE.
EVENT-ON_ROW_BASE = ON_ROW_BASE.
EVENT-ON_CELL = ON_CELL.
EVENT-ON_ROW = ON_ROW.
EVENT-ON_TAG = ON_TAG.
EVENT-ON_COL_WIDTH = ON_COL_WIDTH.
EVENT-ON_EXCEL = ON_EXCEL.
EVENT-ON_CONFIRM = ON_CONFIRM.
EVENT-ON_CONFIRM_PBO = ON_CONFIRM_PBO.
XEVENT = EVENT.
IF EXT = 'X' OR NOT MAINPROG IS INITIAL.
* Для определения имён глобальных переменных переменных
IF MAINPROG IS INITIAL.
MAINPROG = EVENT-PROGRAM.
ENDIF.
PERFORM PREPARE_PROG USING MAINPROG.
ENDIF.
ENDFUNCTION.
* Для определения имён глобальных переменных переменных
* Извращение конечно а что поделаеш. В SAPе сделали-бы лучше
FORM PREPARE_PROG USING PROG.
DATA: ITRDATA LIKE RDATA OCCURS 0 WITH HEADER LINE.
DATA: ITRSYMB LIKE RSYMB OCCURS 0 WITH HEADER LINE.
DATA: OFFSET LIKE RSYMB-DTIX.
DATA: NAME LIKE ITRSYMB-TXOF.
DATA: FIELDNAME(72) TYPE C.
FIELD-SYMBOLS: , .
DATA: PTR POINTER.
DATA: TD TYPE SYDES_DESC,
TD_TYPE TYPE SYDES_TYPEINFO,
TD_NAME TYPE SYDES_NAMEINFO.
DATA: XNAME(72) TYPE C,
INDX LIKE SY-TABIX,
TYP TYPE C,
PNAME_INDEX TYPE I.
DATA: BEGIN OF TDN OCCURS 0,
INDX LIKE SY-TABIX,
PTR POINTER,
TYPE TYPE C,
PNAME(255) TYPE C,
NAME(30) TYPE C,
END OF TDN.
LOAD REPORT PROG PART 'DATA' INTO ITRDATA.
LOAD REPORT PROG PART 'SYMB' INTO ITRSYMB.
DELETE ITRSYMB WHERE KIND <> 'D'.
SORT ITRSYMB BY DTIX.
LOOP AT ITRDATA WHERE TYPE <> 'h'.
OFFSET = SY-TABIX - 1.
READ TABLE ITRSYMB WITH KEY DTIX = OFFSET BINARY SEARCH.
CHECK SY-SUBRC = 0.
NAME = ITRSYMB-TXOF.
CHECK NOT NAME IS INITIAL.
CONCATENATE '(' PROG ')' NAME INTO FIELDNAME.
ASSIGN (FIELDNAME) TO .
CHECK SY-SUBRC = 0.
SYSTEM-CALL POINTER TO PTR.
IF ITRDATA-TYPE = 'u'.
REFRESH TDN.
TDN-INDX = 1.
TDN-TYPE = ITRDATA-TYPE.
TDN-NAME = NAME.
TDN-PNAME = SPACE.
TDN-PTR = PTR.
APPEND TDN.
DESCRIBE FIELD INTO TD.
LOOP AT TD-TYPES INTO TD_TYPE
WHERE TYPE <> 'h'
AND NOT IDX_NAME IS INITIAL.
INDX = SY-TABIX.
TYP = TD_TYPE-TYPE.
READ TABLE TDN WITH KEY INDX = TD_TYPE-BACK.
CHECK SY-SUBRC = 0.
CLEAR XNAME.
DO.
READ TABLE TD-NAMES INDEX TD_TYPE-IDX_NAME INTO TD_NAME.
CONCATENATE XNAME TD_NAME-NAME INTO XNAME.
IF TD_NAME-CONTINUE <> '*'. EXIT. ENDIF.
ADD 1 TO TD_TYPE-IDX_NAME.
ENDDO.
SYSTEM-CALL POINTER FROM TDN-PTR.
ASSIGN COMPONENT XNAME OF STRUCTURE TO .
IF SY-SUBRC = 0.
IF NOT TDN-PNAME IS INITIAL.
CONCATENATE TDN-PNAME '-' TDN-NAME INTO TDN-PNAME.
ELSE.
TDN-PNAME = TDN-NAME.
ENDIF.
TDN-INDX = INDX.
TDN-TYPE = TYP.
TDN-NAME = XNAME.
SYSTEM-CALL POINTER TO TDN-PTR.
APPEND TDN.
ENDIF.
ENDLOOP.
LOOP AT TDN.
ITV-OFFI = TDN-PTR(4).
ITV-OFSG = TDN-PTR+4(2).
ITV-TYPE = TDN-TYPE.
ITV-NAME = TDN-NAME.
IF NOT TDN-PNAME IS INITIAL.
READ TABLE ITVU WITH KEY PNAME = TDN-PNAME BINARY SEARCH.
IF SY-SUBRC <> 0.
ADD 1 TO PNAME_INDEX.
ITVU-PNAME = TDN-PNAME.
ITVU-INDEX = PNAME_INDEX.
INSERT ITVU INDEX SY-TABIX.
ENDIF.
ITV-PNAME = ITVU-INDEX.
ELSE.
ITV-PNAME = 0.
ENDIF.
APPEND ITV.
ENDLOOP.
ELSE.
ITV-OFFI = PTR(4).
ITV-OFSG = PTR+4(2).
ITV-TYPE = ITRDATA-TYPE.
ITV-NAME = NAME.
ITV-PNAME = 0.
APPEND ITV.
ENDIF.
ENDLOOP.
SORT ITV BY OFFI OFSG.
SORT ITVU BY INDEX.
ENDFORM.
FORM GET_VAR_NAME USING NAME.
IF ITV-PNAME IS INITIAL.
NAME = ITV-NAME.
ELSE.
READ TABLE ITVU INDEX ITV-PNAME.
CONCATENATE ITVU-PNAME '-' ITV-NAME INTO NAME.
ENDIF.
ENDFORM.
* Все строки листнга имеющие одинаковое форматирование сгрупированы
* Вызывается на каждой ячейке в группе строк перед началом формирования
FORM ON_CELL_BASE
USING
INDEX " № группы
COL " № столбца
NAME " Имя выводимой глобальной переменной
TD TYPE Y96XL_TD " описание ячейки
CHANGING
CONCATENATE_WITH_PREV " сложить с предидущей ячейкой
SPLIT_AT_POS TYPE I. " разбить ячейку по позиции
PERFORM (EVENT-ON_CELL_BASE) IN PROGRAM (EVENT-PROGRAM)
USING INDEX
COL
NAME
TD
CHANGING CONCATENATE_WITH_PREV
SPLIT_AT_POS.
ENDFORM.
FORM ON_ROW_BASE TABLES CELS TYPE Y96XL_TD_TAB
USING FIRST COUNT EXCLUDE.
PERFORM (EVENT-ON_ROW_BASE) IN PROGRAM (EVENT-PROGRAM)
TABLES CELS
USING FIRST COUNT EXCLUDE.
ENDFORM.
FORM CALL_ON_CELL USING COL VAL TDST
CHANGING STYLE_STR IN_TAG BEFORE_VAL AFTER_VAL.
DATA: NAME(256) TYPE C.
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_CELL IS INITIAL.
CLEAR ITID.
READ TABLE ITID WITH KEY ID = DM-ID BINARY SEARCH.
IF SY-SUBRC = 0.
READ TABLE ITV INDEX ITID-INDEX.
PERFORM GET_VAR_NAME USING NAME.
ENDIF.
PERFORM ON_CELL USING ITL-ORDER
COL
NAME
DM
G_ROW
VAL
TDST
CHANGING STYLE_STR IN_TAG BEFORE_VAL AFTER_VAL.
ENDFORM.
* Вызывается на каждой ячейке
FORM ON_CELL
USING
INDEX " № группы строк
COL " № столбца
NAME " Имя выводимой глобальной переменной
TD TYPE Y96XL_TD " описание ячейки
ROW " № строки
VAL " содержимое ячейки
STYLE TYPE Y96XL_TD_STYLE " описание стиля ячейки
CHANGING
STYLE_STR " стока добавляемая к стилю ячейки
IN_TAG " строка вставляется в тег
BEFORE_VAL " строка вствл. после тега перд. содер. яч
AFTER_VAL. " строка вствл. после содерж. ячейки
PERFORM (EVENT-ON_CELL) IN PROGRAM (EVENT-PROGRAM)
USING INDEX
COL
NAME
TD
ROW
VAL
STYLE
CHANGING STYLE_STR IN_TAG BEFORE_VAL AFTER_VAL.
ENDFORM.
FORM CALL_ON_ROW TABLES HIDE TYPE SLIST_HIDE_TAB
HDLN TYPE SLIST_HIDELINE_TAB
USING ROW
HIDE_INDEX
LINE
CHANGING IN_TAG
CANCEL.
DATA: HROW TYPE I.
DATA: FIELDNAME(72) TYPE C,
INDX LIKE HIDE-INDX.
DATA: ITH(255) TYPE C OCCURS 0 WITH HEADER LINE.
DATA: PTR POINTER.
DATA: XPTR(16) TYPE X.
FIELD-SYMBOLS: TYPE X, TYPE X.
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_ROW IS INITIAL.
* Востанавливаю значения за-Hide-ных переменных
IF NOT HIDE_INDEX IS INITIAL.
HROW = ROW - 1.
LOOP AT HIDE FROM HIDE_INDEX.
IF HIDE-LINNO <> HROW. EXIT. ENDIF.
READ TABLE ITV WITH KEY OFFI = HIDE-OFFI OFSG = HIDE-OFSG
BINARY SEARCH.
CHECK SY-SUBRC = 0.
PERFORM GET_VAR_NAME USING ITH.
APPEND ITH.
XPTR(4) = HIDE-OFFI.
XPTR+4(2) = HIDE-OFSG.
XPTR+6(2) = HIDE-LENG.
XPTR+8(8) = '0180000020000000'. " 2 - type 'X'
PTR = XPTR.
SYSTEM-CALL POINTER FROM PTR.
IF INDX <> HIDE-INDX.
READ TABLE HDLN INDEX HIDE-INDX.
INDX = HIDE-INDX.
ENDIF.
ASSIGN HDLN+HIDE-OFFS(HIDE-LENG) TO TYPE 'X'.
= .
ENDLOOP.
ENDIF.
PERFORM ON_ROW TABLES ITH
USING ROW LINE
CHANGING IN_TAG CANCEL.
ENDFORM.
* Вызывается на каждой строке
* Значения скрытых полей востанавливаются
FORM ON_ROW TABLES HIDEFIELDS " Список скрытых полей в указаной строке
USING ROW " № строки
LINE " Содержимое строки
CHANGING IN_TAG " Строка вставляется тег
CANCEL. " "X" - отменить вывод строки
PERFORM (EVENT-ON_ROW) IN PROGRAM (EVENT-PROGRAM)
TABLES HIDEFIELDS
USING ROW LINE
CHANGING IN_TAG CANCEL.
ENDFORM.
* Вызывается при тегах (кроме и )
* Начальное значение берётся из текстов к группе функций
FORM ON_TAG TABLES ITTAG " Содержимое тега
USING TAGNAME. " Имя тега
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_TAG IS INITIAL.
PERFORM (EVENT-ON_TAG) IN PROGRAM (EVENT-PROGRAM)
TABLES ITTAG
USING TAGNAME.
ENDFORM.
* Вызывается при установке ширины столбцов в Excel
* Возможны два способа установки ширины столбцов
* при большом количестве colspan из за глюка в Excel приходится
* утанавливать ширину столбцов через OLE
FORM ON_COL_WIDTH USING OLE_MODE " X - режм утановки ширины через OLE
COL " № столбца
CHAR_COUNT " Количество символов
WIDTH. " Ширина
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_COL_WIDTH IS INITIAL.
PERFORM (EVENT-ON_COL_WIDTH) IN PROGRAM (EVENT-PROGRAM)
USING OLE_MODE COL CHAR_COUNT WIDTH.
ENDFORM.
* Вызывается после загрузки данных в excel
FORM ON_EXCEL USING H_APPL TYPE OLE2_OBJECT
H_BOOKS TYPE OLE2_OBJECT
H_WORK TYPE OLE2_OBJECT
H_SHEET TYPE OLE2_OBJECT.
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_EXCEL IS INITIAL.
PERFORM (EVENT-ON_EXCEL) IN PROGRAM (EVENT-PROGRAM)
USING H_APPL H_BOOKS H_WORK H_SHEET.
ENDFORM.
* Вызывается при старте выгрузки листинга
FORM ON_START USING CHAR_WIDTH " Шырина символа
COL_DOP " Добавок к ширине столбца
OLE_CHAR_WIDTH " Шырина символа при уст. через OLE
OLE_COL_DOP " Добавок к ширине столбца при OLE
ROW_HEIGHT " Высота строки в Excel
FONT_FAMILY. " Имя шрифт
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_START IS INITIAL.
PERFORM (EVENT-ON_START) IN PROGRAM (EVENT-PROGRAM)
USING CHAR_WIDTH OLE_CHAR_WIDTH ROW_HEIGHT FONT_FAMILY.
ENDFORM.
* Вызывается перед вызовом экрана запроса имени файла
FORM ON_CONFIRM TABLES ITVAR TYPE Y96XL_VAR_TAB " Варианты
USING SVAR TYPE Y96XL_VAR " Выбраный вариант
SCR TYPE Y96XL_SCR " Опции на экране
NOT_CALL_SCREEN " Не вызывать экран
CANCEL. " Отмена выгрузки
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_CONFIRM IS INITIAL.
PERFORM (EVENT-ON_CONFIRM) IN PROGRAM (EVENT-PROGRAM)
TABLES ITVAR
USING SVAR
SCR
NOT_CALL_SCREEN
CANCEL.
ENDFORM.
* Вызывается в PBO логике экрана запроса имени файла
FORM ON_CONFIRM_PBO TABLES ITEXUCOMM
USING SCR TYPE Y96XL_SCR.
CHECK NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_CONFIRM_PBO IS INITIAL.
PERFORM (EVENT-ON_CONFIRM_PBO) IN PROGRAM (EVENT-PROGRAM)
TABLES ITEXUCOMM
USING SCR.
ENDFORM.
FORM CALL_ON_VARIANT.
DATA: MAINPROG LIKE SY-CPROG.
CHECK NOT SELECT_VAR-PROG IS INITIAL
AND NOT SELECT_VAR-FORM IS INITIAL.
PERFORM ON_VARIANT USING EVENT MAINPROG.
IF NOT MAINPROG IS INITIAL.
PERFORM PREPARE_PROG USING MAINPROG.
ENDIF.
IF EVENT-PROGRAM IS INITIAL.
EVENT-PROGRAM = ITVAR-PROG.
ENDIF.
ENDFORM.
FORM ON_VARIANT USING EVENT TYPE Y96XL_EVENT
MAINPROG.
PERFORM (SELECT_VAR-FORM) IN PROGRAM (SELECT_VAR-PROG)
USING EVENT MAINPROG
IF FOUND.
ENDFORM.
Используются технологии uCoz
| |