REPORT Y96_REPORT_TO_HTML MESSAGE-ID Y96_LIST_TO_EXCEL.
* This program has been developed by Kiyanov Dmitryi Evgenevich in 2006y
* Site http://www.dkiyanov.narod.ru
* Email DKiyanov@mail.ru
* It is a demonstration example showing to an opportunity of function
* group "Y96LIST_TO_EXCEL"
* This program is compilation of parts of an source code
* concerning to funcion group "Y96LIST_TO_EXCEL"
*
* Этот пример демострирует только лиш основную возможность
* предоставляемую группой функций "Y96LIST_TO_EXCEL" и то в слегка
* обрезаном виде
PARAMETERS: REPID LIKE RSEUX-CP_VALUE OBLIGATORY DEFAULT 'SHOWCOLO',
VARIANT LIKE RSVAR-VARIANT.
SELECTION-SCREEN SKIP.
PARAMETERS:
PFNAME(132) TYPE C.
SELECTION-SCREEN SKIP.
PARAMETERS:
PEXEC AS CHECKBOX DEFAULT 'X',
PCOLOROF AS CHECKBOX,
PBORDERO AS CHECKBOX,
PSYMBOLM TYPE C DEFAULT '-',
PCHECKBO TYPE C DEFAULT '-',
PICONMOD TYPE C DEFAULT '-',
PCELLSOP AS CHECKBOX DEFAULT 'X',
PNOTCOLS AS CHECKBOX,
PREWRITE TYPE C DEFAULT 'C'.
*TYPE-POOL y96xl.
* Цвет
TYPES: BEGIN OF Y96XL_SID,
COLOR TYPE C, " Номер цвета
INTENSE TYPE C, " Интенсивность значения 'X' или 'O'
INVERSE TYPE C, " Инверсия значения 'X' или 'O'
END OF Y96XL_SID.
* Описание ячейки
TYPES: BEGIN OF Y96XL_TD,
ID(2) TYPE X, " ссылка на fido - ид. вывод переменной
POS TYPE I, " Позиция начала данных
LEN TYPE I, " Длина данных
BGN TYPE I, " Позиция начала ячейки
END TYPE I, " Позиция конца ячейки
SID TYPE Y96XL_SID, " Цвет
VLINE TYPE C, " Вертикальная линия по левому краю
XTYP TYPE X, " slist_fmbx_: checkbox, symbol, icon
COLSPAN TYPE I, " Количество обеденённых яч. Excel
RVLINE TYPE C, " Вертикальная линия по правому краю
UNITED TYPE C, " Несколько ячеек объедененённые в одну
END OF Y96XL_TD.
TYPES: Y96XL_TD_TAB TYPE Y96XL_TD OCCURS 0.
* Стиль ячейки
* Стили ячеек групируются в таблице its ключ sid - ssindex.
TYPES: BEGIN OF Y96XL_TD_STYLE,
SID TYPE Y96XL_SID, " Цвет
LEFT TYPE C, " Граница с лева
TOP TYPE C, " Граница с верху
RIGHT TYPE C, " Граница с права
BOTTOM TYPE C, " Граница с низу
ALIGN TYPE C, " Выравнивания данных L, C, R
GS TYPE C, " Разделитель групп разрядов (флаг)
DECS TYPE C, " Тип данных, Кол-во десятичных разрядов
XTYP TYPE X, " slist_fmbx_: checkbox, symbol, icon
IGCPN TYPE C, " mso-ignore:colspan
SSINDEX TYPE I, " ссылка на строку стиля пользователя
STYLE(6) TYPE C, " текстовый идент. стиля
INDEX TYPE I, " идентификатор стиля
END OF Y96XL_TD_STYLE.
* Опции экрана запроса
TYPES: BEGIN OF Y96XL_SCR,
FNAME LIKE RLGRAP-FILENAME, " Имя файла
EXEC TYPE C, " Открыть файл
COLOR_OFF TYPE C, " Выключить расцветку
BORDER_OFF TYPE C, " Выключить границы
NOTCOLSPAN TYPE C, " Не объеденять ячейки
CELLS_OPTIMIZATION TYPE C, " Оптимизация ячеек
ROWFILTER_ON TYPE C, " Вывести строковый фильтр
SYMBOL_MODE TYPE C, " Режим SAP-symbol-ов
CHECKBOX_MODE TYPE C, " Режим CheckBox-ов
ICON_MODE TYPE C, " Режим иконок
ADV TYPE C, " Расширеный режим на экрана
END OF Y96XL_SCR.
* Режимы SAP-symbol, CheckBox, Icon
* "-" - Выводится путое место
* "T" - Текстовое значение объекта
* "X" - Выводится соотв. объект
* События
TYPES: BEGIN OF Y96XL_EVENT,
PROGRAM LIKE SY-REPID, " CallBack программа
ON_START(30) TYPE C, " При старте
ON_ROW_BASE(30) TYPE C, " На каждой ячейке в группе строк
ON_CELL_BASE(30) TYPE C, " На каждой группе строк
ON_CELL(30) TYPE C, " На каждй ячейке
ON_ROW(30) TYPE C, " На каждой строке
ON_TAG(30) TYPE C, " На тегах
ON_COL_WIDTH(30) TYPE C, " При установке ширины столбца
ON_EXCEL(30) TYPE C, " После передачи данных в Excel
ON_CONFIRM(30) TYPE C, " Перед экраном запроса имени фай
ON_CONFIRM_PBO(30) TYPE C, " В PBO логиике экрана запроса им
END OF Y96XL_EVENT.
* Вырианты выгрузки
TYPES: BEGIN OF Y96XL_VAR,
PROG LIKE Y96LIST_TO_EXCEL-PROG,
FORM LIKE Y96LIST_TO_EXCEL-FORM,
TEXT LIKE Y96LIST_TO_EXCEL-TEXT,
END OF Y96XL_VAR.
TYPES: Y96XL_VAR_TAB TYPE Y96XL_VAR OCCURS 0.
*FUNCTION-POOL y96_list_to_excel MESSAGE-ID y96_list_to_excel.
TYPE-POOLS: SLIST, SYDES.
INCLUDE .
INCLUDE OLE2INCL.
DATA: CHAR_WIDTH_X TYPE F VALUE '1.11'.
DATA: CHAR_WIDTH_X_D TYPE F VALUE '0.23'.
DATA: CHAR_WIDTH_P TYPE F VALUE '10'.
DATA: CHAR_WIDTH_P_D TYPE F VALUE '7'.
DATA: ROW_HEIGHT(5) TYPE C VALUE '13.8'.
DATA: FONT_FAMILY(30) TYPE C VALUE 'COURIER NEW'.
DATA: SAP_ICONS_DIR(30) TYPE C VALUE 'SAP_ICONS'.
DATA: XLS_SPACE_TRANSLATE(2) TYPE X VALUE '20A0'.
DATA: XLS_PREPARE_COL_WIDTH TYPE C.
DATA: GINIT TYPE C.
DATA: BEGIN OF ITTP OCCURS 0,
KEY(3) TYPE C,
TEXT(132) TYPE C,
END OF ITTP.
DATA: SCR TYPE Y96XL_SCR.
DEFINE SET_PARAM.
PERFORM INIT.
SCR-FNAME = FILENAME.
SCR-EXEC = EXEC.
SCR-COLOR_OFF = COLOR_OFF.
SCR-BORDER_OFF = BORDER_OFF.
SCR-SYMBOL_MODE = SYMBOL_MODE.
SCR-CHECKBOX_MODE = CHECKBOX_MODE.
SCR-ICON_MODE = ICON_MODE.
SCR-CELLS_OPTIMIZATION = CELLS_OPTIMIZATION.
SCR-NOTCOLSPAN = NOTCOLSPAN.
SCR-ROWFILTER_ON = ROWFILTER_ON.
XLSREWRITE = REWRITE.
CLEAR SY-SUBRC.
IF CONFIRM = 'X'.
PERFORM CONFIRM_FILENAME.
CHECK SY-SUBRC = 0.
ELSE.
PERFORM CHECK_FILE USING FILENAME.
ENDIF.
END-OF-DEFINITION.
DATA: XLSEXT(10) TYPE C VALUE '.XLS'.
DATA: XLSHTML TYPE C.
DATA: XLS_X_MODE TYPE C.
DATA: XLSREWRITE TYPE C.
DATA: EVENT TYPE Y96XL_EVENT.
DATA: XEVENT TYPE Y96XL_EVENT.
DATA: H_APPL TYPE OLE2_OBJECT.
DATA: H_BOOKS TYPE OLE2_OBJECT.
DATA: H_WORK TYPE OLE2_OBJECT.
DATA: H_SHEET TYPE OLE2_OBJECT.
DATA: SRC_CODEPAGE(4) TYPE C,
DST_CODEPAGE(4) TYPE C.
DATA: LIST_WIDTH TYPE I.
DATA: BEGIN OF ITL OCCURS 0,
FSEL TYPE SLIST_LISTLINE-FSEL,
FMBI TYPE SLIST_LISTLINE-FMBI,
FMBX TYPE SLIST_LISTLINE-FMBX,
LENG TYPE SLIST_LISTLINE-LENG,
VLINE TYPE C,
COLSPAN_COUNT TYPE I,
ITD TYPE Y96XL_TD OCCURS 0,
INDEX LIKE SY-TABIX, " Ссылка на itlp-index
FIRST LIKE SY-TABIX, " Ссылка на itlf
COUNT TYPE I, " Количество строк с таким форматом
UNIFY TYPE C, " Объеденить все ячейки в строке
EXLUD TYPE C, " Исключить строку
ORDER TYPE I,
END OF ITL.
DATA: BEGIN OF ITLP OCCURS 0,
INDEX LIKE SY-TABIX,
POS TYPE I,
END OF ITLP.
DATA: BEGIN OF ITLI OCCURS 0,
VLINE TYPE C, " ca vline
ULINE TYPE C, " ca uline
COULN TYPE C, " co uline
INDEX LIKE SY-TABIX, " Ссылка на itl
END OF ITLI.
DATA: DM TYPE Y96XL_TD.
DATA: BEGIN OF ITCOL OCCURS 0,
POS TYPE I,
WIDTH TYPE I,
END OF ITCOL.
DATA: BEGIN OF ITF OCCURS 0,
FMBI TYPE SLIST_LISTLINE-FMBI,
FORMAT TYPE X,
SID TYPE Y96XL_SID,
BGN TYPE I,
END TYPE I,
END OF ITF.
DATA: ITS TYPE Y96XL_TD_STYLE OCCURS 0 WITH HEADER LINE.
DATA: STYLE_INDEX TYPE I.
DATA: BEGIN OF ITSS OCCURS 0,
INDEX TYPE I,
STR(1000) TYPE C,
END OF ITSS.
DATA: STYLE_STR_INDEX TYPE I.
DATA: BEGIN OF ITX OCCURS 0,
FMBX TYPE SLIST_LISTLINE-FMBX,
BGN TYPE I,
END TYPE I,
TYP TYPE I,
END OF ITX.
DATA: BTEXT(2046) TYPE C.
DATA: HBUFER(255) TYPE C OCCURS 0.
DATA: SBUFER(255) TYPE C OCCURS 0.
FIELD-SYMBOLS TYPE STANDARD TABLE.
DATA: GAP(2) TYPE X,
VLX(2) TYPE X VALUE 'FFFF',
FMBX_OFF TYPE X.
DATA: RET(2) TYPE X VALUE '0D0A'. " Перевод строки
DATA: DCS TYPE C,
NGS TYPE C.
DATA: GSTRANSLATE(2) TYPE C.
DATA: DATFMT LIKE USR01-DATFM.
DATA: BEGIN OF ITV OCCURS 0,
OFFI TYPE SLIST_FIDOLINE-OFFI,
OFSG TYPE SLIST_FIDOLINE-OFSG,
TYPE LIKE RDATA-TYPE,
NAME(30) TYPE C,
PNAME LIKE SY-TABIX,
END OF ITV.
DATA: BEGIN OF ITVU OCCURS 0,
PNAME(255) TYPE C,
INDEX TYPE I,
END OF ITVU.
DATA: BEGIN OF ITID OCCURS 0,
ID(2) TYPE X,
INDEX LIKE SY-TABIX,
END OF ITID.
DATA: G_ROW TYPE I.
DATA: PROGRAM_DIR(255) TYPE C.
DATA: BEGIN OF ITICONS OCCURS 0,
NAME LIKE ICON-NAME,
INTERNAL LIKE ICON-INTERNAL,
END OF ITICONS.
DATA: MINUS TYPE C. "
DATA: XLIST TYPE SLIST_LIST_TAB.
DATA: BREAK TYPE C.
DATA: SELECT_VAR TYPE Y96XL_VAR.
DATA: ITVAR TYPE Y96XL_VAR_TAB WITH HEADER LINE.
DATA: ITEXUCOMM LIKE SY-UCOMM OCCURS 0.
DATA: RGD TYPE C.
DATA: CH_LINE(2) TYPE C.
AT SELECTION-SCREEN OUTPUT.
%_REPID_%_APP_%-TEXT = 'Report'.
%_VARIANT_%_APP_%-TEXT = 'Variant'.
%_PFNAME_%_APP_%-TEXT = 'File name'.
%_PEXEC_%_APP_%-TEXT = 'Open file'.
%_PCOLOROF_%_APP_%-TEXT = 'Colors off'.
%_PBORDERO_%_APP_%-TEXT = 'Borders off'.
%_PSYMBOLM_%_APP_%-TEXT = 'SAP Symbols mode: "-", "T", "X"'.
%_PCHECKBO_%_APP_%-TEXT = 'CheckBox mode: "-", "T", "X"'.
%_PICONMOD_%_APP_%-TEXT = 'Icon mode: "-", "T", "X"'.
%_PCELLSOP_%_APP_%-TEXT = 'Cells optimization'.
%_PNOTCOLS_%_APP_%-TEXT = 'Not colspan'.
%_PREWRITE_%_APP_%-TEXT = 'ReWrite mode: "C", "R"'.
AT SELECTION-SCREEN ON VALUE-REQUEST FOR PFNAME.
PERFORM F4_FNAME.
START-OF-SELECTION.
PERFORM START_OF_SELECTION.
PERFORM WRITE_ABOUT.
AT LINE-SELECTION.
CHECK SY-LISEL CS 'Site'.
CALL FUNCTION 'WS_EXECUTE'
EXPORTING
PROGRAM = 'http://www.dkiyanov.narod.ru'
EXCEPTIONS
FRONTEND_ERROR = 1
NO_BATCH = 2
PROG_NOT_FOUND = 3
ILLEGAL_OPTION = 4
GUI_REFUSE_EXECUTE = 5
OTHERS = 6.
FORM START_OF_SELECTION.
DATA:
FILENAME(132) TYPE C, " Имя файла
CONFIRM TYPE C, " Вывести экран для запроса имени файла
EXEC TYPE C, " Открыть файл
COLOR_OFF TYPE C, " Выключить цвета
BORDER_OFF TYPE C, " Выключить границы столбцов
SYMBOL_MODE TYPE C, " Режим SAP-symbol-ов
CHECKBOX_MODE TYPE C, " Режим CheckBox-ов
ICON_MODE TYPE C, " Режим иконок
CELLS_OPTIMIZATION TYPE C, " Оптимизация ячеек
NOTCOLSPAN TYPE C, " Не объеденять ячейки
ROWFILTER_ON TYPE C, " Вывести строковый фильтр
REWRITE TYPE C. " Режим презаписи файла: С, R,
DATA: LIST LIKE ABAPLIST OCCURS 0 WITH HEADER LINE.
DATA: XREPID LIKE SY-REPID.
IF VARIANT IS INITIAL.
SUBMIT (REPID) " VIA SELECTION-SCREEN
EXPORTING LIST TO MEMORY
AND RETURN.
ELSE.
SUBMIT (REPID) " VIA SELECTION-SCREEN
USING SELECTION-SET VARIANT
EXPORTING LIST TO MEMORY
AND RETURN.
ENDIF.
CALL FUNCTION 'LIST_FROM_MEMORY'
TABLES
LISTOBJECT = LIST
EXCEPTIONS
NOT_FOUND = 1
OTHERS = 2.
* CALL FUNCTION 'Y96_LISTOBJECT_TO_EXCEL_BY_HTM'
* TABLES
* listobject = list
* EXCEPTIONS
* OTHERS = 1.
FILENAME(132) = PFNAME.
EXEC = PEXEC.
COLOR_OFF = PCOLOROF.
BORDER_OFF = PBORDERO.
SYMBOL_MODE = PSYMBOLM.
CHECKBOX_MODE = PCHECKBO.
ICON_MODE = PICONMOD.
CELLS_OPTIMIZATION = PCELLSOP.
NOTCOLSPAN = PNOTCOLS.
REWRITE = PREWRITE.
SET_PARAM.
XREPID = SY-REPID.
CALL FUNCTION 'GET_REPORT_LISTS'
EXPORTING
CALLBACK_FORM = 'LISTOBJECT_TO_HTML'
CALLBACK_PROGRAM = XREPID
TABLES
LISTOBJECT = LIST
EXCEPTIONS
OTHERS = 1.
PERFORM SAVE_FILE USING SCR-FNAME SCR-EXEC.
ENDFORM.
FORM LISTOBJECT_TO_HTML
TABLES LIST_PAGES TYPE SLIST_PAGEDESCR_TAB
LIST TYPE SLIST_LIST_TAB
FMBS TYPE SLIST_FMBS_TAB
FMBX TYPE SLIST_FMBS_TAB
FSEL TYPE SLIST_FSEL_TAB
HYPER_TAGS TYPE SLIST_HYPERTAGS_TAB.
DATA: FIDO TYPE SLIST_FIDO_TAB.
DATA: HIDE TYPE SLIST_HIDE_TAB.
DATA: HDLN TYPE SLIST_HIDELINE_TAB.
PERFORM GET_HTML TABLES LIST FMBS FMBX FSEL FIDO HIDE HDLN.
ENDFORM.
FORM CONVERT_LINE_BY_FMBX TABLES FMBX TYPE SLIST_FMBS_TAB
USING LIST TYPE SLIST_LISTLINE.
DATA: POS TYPE I.
FIELD-SYMBOLS: TYPE X,
TYPE C.
CHECK NOT LIST-FMBX IS INITIAL.
READ TABLE FMBX INDEX LIST-FMBX.
DO LIST-LENG TIMES.
ASSIGN FMBX-LINE+POS(1) TO .
IF = SLIST_FMBX_LINE.
ASSIGN LIST-LINE+POS(1) TO .
CASE .
WHEN LINE_HORIZONTAL_LINE.
= SY-ULINE(1). " '-'
WHEN OTHERS.
= SY-VLINE. " '|'
ENDCASE.
ENDIF.
ADD 1 TO POS.
ENDDO.
ENDFORM.
FORM ANALIZE_LIST
TABLES LIST TYPE SLIST_LIST_TAB
FMBX TYPE SLIST_FMBS_TAB.
DATA: ORDER TYPE I.
DATA: POS TYPE I.
DATA: INDEX LIKE SY-TABIX.
DATA: FADD TYPE C.
DATA: LIST_TABIX LIKE SY-TABIX.
DATA: BEGIN OF ITLV OCCURS 0,
LINE TYPE SLIST_LISTLINE-LINE,
INDEX LIKE SY-INDEX,
END OF ITLV.
FIELD-SYMBOLS TYPE C.
LOOP AT LIST.
LIST_TABIX = SY-TABIX.
IF LIST_WIDTH < LIST-LENG. LIST_WIDTH = LIST-LENG. ENDIF.
PERFORM CONVERT_LINE_BY_FMBX TABLES FMBX USING LIST.
CLEAR: ITLV, ITL, ITLI, POS, FADD.
ITLI-COULN = 'X'.
DO LIST-LENG TIMES.
ASSIGN LIST-LINE+POS(1) TO .
CASE .
WHEN SY-VLINE.
ITLV-LINE+POS(1) = SY-VLINE.
ITL-VLINE = 'X'.
ITLI-VLINE = 'X'.
WHEN SY-ULINE(1).
ITLI-ULINE = 'X'.
WHEN ' '.
WHEN OTHERS.
CLEAR ITLI-COULN.
ENDCASE.
ADD 1 TO POS.
ENDDO.
IF ITL-VLINE = 'X'.
READ TABLE ITLV WITH KEY LINE = ITLV-LINE BINARY SEARCH.
ELSE.
CLEAR: SY-SUBRC.
ENDIF.
IF SY-SUBRC <> 0.
ADD 1 TO INDEX.
ITLV-INDEX = INDEX.
INSERT ITLV INDEX SY-TABIX.
FADD = 'X'.
ELSE.
READ TABLE ITL WITH KEY FSEL = LIST-FSEL
FMBI = LIST-FMBI
FMBX = LIST-FMBX
INDEX = ITLV-INDEX
BINARY SEARCH.
IF SY-SUBRC <> 0.
FADD = 'X'.
ELSE.
ADD 1 TO ITL-COUNT.
MODIFY ITL INDEX SY-TABIX TRANSPORTING COUNT.
ENDIF.
ENDIF.
IF FADD = 'X'.
ADD 1 TO ORDER.
ITL-FSEL = LIST-FSEL.
ITL-FMBI = LIST-FMBI.
ITL-FMBX = LIST-FMBX.
ITL-INDEX = ITLV-INDEX.
ITL-LENG = LIST-LENG.
ITL-FIRST = LIST_TABIX.
ITL-COUNT = 1.
ITL-ORDER = ORDER.
APPEND ITL.
ENDIF.
ITLI-INDEX = ITL-ORDER.
APPEND ITLI.
ENDLOOP.
LOOP AT ITLV.
ITLP-INDEX = ITLV-INDEX.
READ TABLE ITL WITH KEY INDEX = ITLP-INDEX.
CLEAR POS.
DO ITL-LENG TIMES.
ASSIGN ITLV-LINE+POS(1) TO .
IF = SY-VLINE.
ITLP-POS = POS.
APPEND ITLP.
ENDIF.
ADD 1 TO POS.
ENDDO.
ENDLOOP.
SORT ITL BY ORDER.
ENDFORM.
FORM ANALIZE_FSEL TABLES FSEL TYPE SLIST_FSEL_TAB.
DATA: CHP TYPE I,
ID(2) TYPE X,
ID_PREV(2) TYPE X,
IDP TYPE I.
DATA: ITDX TYPE Y96XL_TD OCCURS 0 WITH HEADER LINE.
DATA: WDY TYPE Y96XL_TD.
DATA: ITDY TYPE Y96XL_TD OCCURS 0 WITH HEADER LINE.
DATA: TABIX LIKE SY-TABIX,
GTABIX LIKE SY-TABIX.
DATA: FSEL_INDEX LIKE SY-TABIX.
DATA: COL TYPE I,
NAME(255) TYPE C,
CWP TYPE C,
SPLIT TYPE I.
DATA: TCOLSPAN_COUNT TYPE I.
DATA: ANSWER TYPE C.
LOOP AT FSEL.
FSEL_INDEX = SY-TABIX.
READ TABLE ITL WITH KEY FSEL = FSEL_INDEX TRANSPORTING LENG.
CLEAR: CHP, IDP, ID, ITDX, ITDX[].
DO ITL-LENG TIMES.
ID_PREV = ID.
ID = FSEL-LINE+IDP(2).
IF ID <> ID_PREV.
IF CHP > 0.
ITDX-LEN = CHP - ITDX-POS.
ITDX-BGN = ITDX-POS.
ITDX-END = CHP - 1.
APPEND ITDX.
ENDIF.
ITDX-ID = ID.
ITDX-POS = CHP.
ENDIF.
ADD 1 TO CHP.
ADD 2 TO IDP.
ENDDO.
ITDX-LEN = CHP - ITDX-POS.
ITDX-BGN = ITDX-POS.
ITDX-END = CHP - 1.
APPEND ITDX.
* Слегка растянутый и не совсем эфективнй алгоритм получился
* (исторически сложилось) но зато более понятный
* и учитывая что записей здесь силно много быть не должно
* думаю покатит и так
LOOP AT ITL WHERE FSEL = FSEL_INDEX.
IF ITL-VLINE = 'X'.
REFRESH ITDY.
LOOP AT ITDX.
LOOP AT ITLP WHERE INDEX = ITL-INDEX
AND POS BETWEEN ITDX-BGN AND ITDX-END.
IF ITDX-BGN <= ITLP-POS.
IF ITDX-BGN < ITLP-POS.
WDY = ITDX.
WDY-END = ITLP-POS - 1.
WDY-LEN = WDY-END - WDY-POS + 1.
APPEND WDY TO ITDY.
ENDIF.
WDY-POS = ITLP-POS.
WDY-BGN = ITLP-POS.
WDY-END = ITLP-POS.
WDY-LEN = 1.
WDY-ID = VLX.
APPEND WDY TO ITDY.
ITDX-POS = ITLP-POS + 1.
ITDX-BGN = ITLP-POS + 1.
ITDX-LEN = ITDX-END - ITDX-POS + 1.
ENDIF.
ENDLOOP.
IF ITDX-LEN > 0.
APPEND ITDX TO ITDY.
ENDIF.
ENDLOOP.
ELSE.
ITDY[] = ITDX[].
ENDIF.
LOOP AT ITF WHERE FMBI = ITL-FMBI.
LOOP AT ITDY WHERE BGN < ITF-BGN AND END >= ITF-BGN.
WDY = ITDY.
WDY-END = ITF-BGN - 1.
WDY-LEN = WDY-END - WDY-POS + 1.
MODIFY ITDY FROM WDY INDEX SY-TABIX.
ITDY-BGN = ITF-BGN.
ITDY-POS = ITF-BGN.
ITDY-LEN = ITDY-END - ITDY-POS + 1.
ADD 1 TO SY-TABIX.
INSERT ITDY INDEX SY-TABIX.
EXIT.
ENDLOOP.
ENDLOOP.
LOOP AT ITF WHERE FMBI = ITL-FMBI.
ITDY-SID = ITF-SID.
MODIFY ITDY TRANSPORTING SID
WHERE BGN >= ITF-BGN
AND END <= ITF-END.
ENDLOOP.
LOOP AT ITX WHERE FMBX = ITL-FMBX.
ITDY-XTYP = ITX-TYP.
MODIFY ITDY TRANSPORTING XTYP
WHERE BGN BETWEEN ITX-BGN AND ITX-END
OR END BETWEEN ITX-BGN AND ITX-END.
ENDLOOP.
LOOP AT ITDY WHERE ID = GAP AND LEN = 1.
GTABIX = SY-TABIX.
TABIX = GTABIX - 1.
READ TABLE ITDY INDEX TABIX.
IF SY-SUBRC <> 0 OR ITDY-ID = VLX.
TABIX = GTABIX + 1.
READ TABLE ITDY INDEX TABIX.
CHECK SY-SUBRC = 0 AND ITDY-ID <> VLX.
SUBTRACT 1 FROM ITDY-BGN. " Пристыковываем в начало следующего
ELSE.
ADD 1 TO ITDY-END. " Пристыковываем в конец предидущего
ENDIF.
MODIFY ITDY INDEX TABIX TRANSPORTING BGN END.
DELETE ITDY INDEX GTABIX.
ENDLOOP.
LOOP AT ITDY WHERE ID = VLX.
GTABIX = SY-TABIX.
TABIX = GTABIX + 1.
READ TABLE ITDY INDEX TABIX.
IF SY-SUBRC = 0 AND ITDY-ID <> VLX.
SUBTRACT 1 FROM ITDY-BGN. " Пристыковываем в начало следующего
ITDY-VLINE = 'X'.
MODIFY ITDY INDEX TABIX TRANSPORTING BGN VLINE.
DELETE ITDY INDEX GTABIX.
ELSE.
ITDY-VLINE = 'X'.
MODIFY ITDY INDEX GTABIX TRANSPORTING VLINE.
ENDIF.
ENDLOOP.
* Program exit
IF NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_CELL_BASE IS INITIAL.
CLEAR COL.
LOOP AT ITDY.
GTABIX = SY-TABIX.
ADD 1 TO COL.
CLEAR: NAME, CWP, SPLIT.
READ TABLE ITID WITH KEY ID = ITDY-ID BINARY SEARCH.
IF SY-SUBRC = 0.
READ TABLE ITV INDEX ITID-INDEX.
* PERFORM get_var_name USING name.
ENDIF.
* PERFORM on_cell_base USING itl-order
* col
* name
* itdy
* CHANGING cwp
* split.
IF NOT SPLIT IS INITIAL. " Разбиение
IF SPLIT <= 0 OR SPLIT >= ITDY-END. MESSAGE E008. ENDIF.
WDY = ITDY.
WDY-BGN = SPLIT.
WDY-POS = SPLIT.
WDY-LEN = WDY-END - WDY-POS + 1.
TABIX = GTABIX + 1.
WDY-VLINE = SPACE.
INSERT WDY INTO ITDY INDEX TABIX.
ITDY-END = SPLIT - 1.
ITDY-LEN = ITDY-END - ITDY-POS + 1.
MODIFY ITDY INDEX GTABIX.
ENDIF.
IF CWP = 'X'. " Склеивание с предидущей
TABIX = GTABIX - 1.
IF TABIX < 1. MESSAGE E009. ENDIF.
WDY = ITDY.
READ TABLE ITDY INDEX TABIX.
ITDY-END = WDY-END.
ITDY-LEN = ITDY-END - ITDY-POS + 1.
MODIFY ITDY INDEX TABIX.
DELETE ITDY INDEX GTABIX.
ENDIF.
ENDLOOP.
ENDIF.
IF NOT ITDY[] IS INITIAL.
IF NOT EVENT-PROGRAM IS INITIAL
AND NOT EVENT-ON_ROW_BASE IS INITIAL.
* PERFORM on_row_base TABLES itdy
* USING itl-first itl-count itl-exlud.
ENDIF.
ITL-ITD[] = ITDY[].
MODIFY ITL INDEX ITL-ORDER TRANSPORTING ITD EXLUD.
ENDIF.
ENDLOOP.
ENDLOOP.
PERFORM CELLS_OPTIMIZATION.
PERFORM SHOW_ROW_FILTER.
LOOP AT ITL.
GTABIX = SY-TABIX.
DESCRIBE TABLE ITL-ITD.
READ TABLE ITL-ITD INTO DM INDEX SY-TFILL.
IF DM-VLINE = 'X' AND DM-ID = VLX AND DM-BGN = DM-END.
TABIX = SY-TABIX - 1.
CHECK TABIX > 0.
DELETE ITL-ITD INDEX SY-TABIX.
READ TABLE ITL-ITD INTO DM INDEX TABIX.
ADD 1 TO DM-END.
DM-RVLINE = 'X'.
MODIFY ITL-ITD FROM DM INDEX TABIX TRANSPORTING RVLINE END.
MODIFY ITL INDEX GTABIX TRANSPORTING ITD.
ENDIF.
ENDLOOP.
IF XLSHTML = 'X'.
LOOP AT ITL.
GTABIX = SY-TABIX.
CLEAR TABIX.
LOOP AT ITL-ITD INTO DM WHERE VLINE = 'X'.
TABIX = SY-TABIX - 1.
CHECK TABIX > 0.
DM-RVLINE = 'X'.
MODIFY ITL-ITD FROM DM INDEX TABIX TRANSPORTING RVLINE.
ENDLOOP.
IF NOT TABIX IS INITIAL.
MODIFY ITL INDEX GTABIX TRANSPORTING ITD.
ENDIF.
ENDLOOP.
ENDIF.
LOOP AT ITL WHERE EXLUD <> 'X'.
LOOP AT ITL-ITD INTO DM.
* Передний фронт
READ TABLE ITCOL WITH KEY POS = DM-BGN BINARY SEARCH.
IF SY-SUBRC <> 0.
ITCOL-POS = DM-BGN.
INSERT ITCOL INDEX SY-TABIX.
ENDIF.
* Задний фронт
ITCOL-POS = DM-END + 1.
READ TABLE ITCOL WITH KEY POS = ITCOL-POS BINARY SEARCH.
IF SY-SUBRC <> 0.
INSERT ITCOL INDEX SY-TABIX.
ENDIF.
ENDLOOP.
ENDLOOP.
LOOP AT ITL WHERE EXLUD <> 'X'.
GTABIX = SY-TABIX.
LOOP AT ITL-ITD INTO DM.
TABIX = SY-TABIX.
LOOP AT ITCOL WHERE POS > DM-BGN AND POS <= DM-END.
ADD 1 TO DM-COLSPAN.
ENDLOOP.
MODIFY ITL-ITD FROM DM INDEX TABIX TRANSPORTING COLSPAN.
ENDLOOP.
MODIFY ITL INDEX GTABIX TRANSPORTING ITD.
ENDLOOP.
LOOP AT ITL WHERE EXLUD <> 'X'.
GTABIX = SY-TABIX.
LOOP AT ITL-ITD INTO DM WHERE NOT COLSPAN IS INITIAL.
ADD 1 TO ITL-COLSPAN_COUNT.
ENDLOOP.
MODIFY ITL INDEX GTABIX TRANSPORTING COLSPAN_COUNT.
TCOLSPAN_COUNT = TCOLSPAN_COUNT + ITL-COLSPAN_COUNT * ITL-COUNT.
ENDLOOP.
CLEAR CHP.
LOOP AT ITCOL.
TABIX = SY-TABIX - 1.
IF TABIX > 0.
ITCOL-WIDTH = ITCOL-POS - CHP.
MODIFY ITCOL INDEX TABIX TRANSPORTING WIDTH.
ENDIF.
CHP = ITCOL-POS.
ENDLOOP.
DELETE ITCOL WHERE WIDTH IS INITIAL.
DESCRIBE TABLE ITCOL.
IF SY-TFILL > 256.
MESSAGE I014 WITH SY-TFILL.
ENDIF.
IF TCOLSPAN_COUNT > 1000
AND SCR-NOTCOLSPAN <> 'X'.
CALL FUNCTION 'POPUP_TO_CONFIRM_STEP'
EXPORTING
TEXTLINE1 = TEXT-008
TEXTLINE2 = TEXT-009
TITEL = TEXT-010
ANSWER = ANSWER
EXCEPTIONS
OTHERS = 1.
CASE ANSWER.
WHEN 'J'. SCR-NOTCOLSPAN = 'X'.
WHEN 'A'. BREAK = 'X'.
ENDCASE.
ENDIF.
ENDFORM.
FORM SHOW_ROW_FILTER.
ENDFORM.
FORM LIST_ROW_FILTER USING EVENT.
ENDFORM.
* Формат
FORM ANALIZE_FMBS TABLES LIST TYPE SLIST_LIST_TAB
FMBS TYPE SLIST_FMBS_TAB.
DATA: FT TYPE X,
FT_PREV TYPE X,
FTP TYPE I,
XTABIX LIKE SY-TABIX.
CLEAR XTABIX.
LOOP AT FMBS.
READ TABLE LIST WITH KEY FMBI = SY-TABIX TRANSPORTING FMBI LENG.
CLEAR: FT, FTP.
DO LIST-LENG TIMES.
FT_PREV = FT.
FT = FMBS-LINE+FTP(1).
IF FT <> FT_PREV.
IF FTP > 0.
ITF-END = FTP - 1.
APPEND ITF.
ADD 1 TO XTABIX.
ENDIF.
ITF-FMBI = LIST-FMBI.
ITF-FORMAT = FT.
ITF-BGN = FTP.
ENDIF.
ADD 1 TO FTP.
ENDDO.
ITF-END = FTP - 1.
APPEND ITF.
ADD 1 TO XTABIX.
ENDLOOP.
LOOP AT itf.
ITF-SID-COLOR = ITF-FORMAT MOD 8. " color
IF ITF-FORMAT O SLIST_FMBS_INTENSE. " intense
ITF-SID-INTENSE = 'X'.
ELSE.
ITF-SID-INTENSE = 'O'.
ENDIF.
IF itf-format O slist_fmbs_inverse. " inverse
ITF-SID-INVERSE = 'X'.
ELSE.
ITF-SID-INVERSE = 'O'.
ENDIF.
MODIFY ITF INDEX SY-TABIX TRANSPORTING SID.
ENDLOOP.
ENDFORM.
FORM ANALIZE_FMBX TABLES LIST TYPE SLIST_LIST_TAB
FMBX TYPE SLIST_FMBS_TAB.
DATA: POS TYPE I,
CUR TYPE X,
PREV TYPE X.
LOOP AT FMBX.
READ TABLE LIST WITH KEY FMBX = SY-TABIX TRANSPORTING FMBX LENG.
CLEAR: ITX, POS, CUR, PREV.
DO LIST-LENG TIMES.
PREV = CUR.
CUR = FMBX-LINE+POS(1).
IF CUR = SLIST_FMBX_LINE. CLEAR CUR. ENDIF.
IF CUR <> PREV.
IF NOT ITX-TYP IS INITIAL.
ITX-END = POS - 1.
APPEND ITX.
ENDIF.
ITX-FMBX = LIST-FMBX.
ITX-BGN = POS.
ITX-TYP = CUR.
ENDIF.
ADD 1 TO POS.
ENDDO.
IF NOT ITX-TYP IS INITIAL.
ITX-END = POS - 1.
APPEND ITX.
ENDIF.
ENDLOOP.
ENDFORM.
FORM GET_COLOR USING ASID TYPE Y96XL_SID STYLE.
DATA: SID(3) TYPE C,
COLOR(15) TYPE C.
CHECK NOT ASID IS INITIAL.
SID = ASID.
* Цвета подобраны из палитры EXCELя
CASE SID.
WHEN '0OO'. COLOR = '#FFFFFF'.
WHEN '1OO'. COLOR = '#9CCFFF'.
WHEN '2OO'. COLOR = '#CEFFFF'.
WHEN '3OO'. COLOR = '#FFFF9C'.
WHEN '4OO'. COLOR = '#CECFFF'.
WHEN '5OO'. COLOR = '#CEFFCE'.
WHEN '6OO'. COLOR = '#FF8284'.
WHEN '7OO'. COLOR = '#FFCF9C'.
WHEN '0XO'. COLOR = '#FFFFFF'.
WHEN '1XO'. COLOR = '#00CFFF'.
WHEN '2XO'. COLOR = '#FFFFCE'.
WHEN '3XO'. COLOR = '#FFFF00'.
WHEN '4XO'. COLOR = '#9CCFFF'.
WHEN '5XO'. COLOR = '#00FF00'.
WHEN '6XO'. COLOR = '#FF0000'.
WHEN '7XO'. COLOR = '#FF9A00'.
WHEN '0OX'. COLOR = '#FFFFFF'.
WHEN '1OX'. COLOR = '#00CFFF'.
WHEN '2OX'. COLOR = '#FFFFCE'.
WHEN '3OX'. COLOR = '#FFFF00'.
WHEN '4OX'. COLOR = '#9CCFFF'.
WHEN '5OX'. COLOR = '#00FF00'.
WHEN '6OX'. COLOR = '#FF0000'.
WHEN '7OX'. COLOR = '#FF9A00'.
WHEN '0XX'. COLOR = '#FFFFFF'.
WHEN '1XX'. COLOR = '#00CFFF'.
WHEN '2XX'. COLOR = '#FFFFCE'.
WHEN '3XX'. COLOR = '#FFFF00'.
WHEN '4XX'. COLOR = '#9CCFFF'.
WHEN '5XX'. COLOR = '#00FF00'.
WHEN '6XX'. COLOR = '#FF0000'.
WHEN '7XX'. COLOR = '#FF9A00'.
ENDCASE.
IF ASID-COLOR = '0'.
IF ASID-INVERSE = 'X'. COLOR = '#C6C3C6'.
ELSEIF ASID-INTENSE = 'X'. COLOR = '#31309C'.
ELSE. EXIT.
ENDIF.
CONCATENATE STYLE 'COLOR:' COLOR ';' INTO STYLE.
EXIT.
ENDIF.
IF ASID-INVERSE = 'O'.
CONCATENATE STYLE 'BACKGROUND-COLOR:' COLOR ';' INTO STYLE.
ELSE.
CONCATENATE STYLE 'COLOR:' COLOR ';' INTO STYLE.
ENDIF.
ENDFORM.
FORM GET_BORDER USING LEFT TOP RIGHT BOTTOM STYLE.
CONCATENATE STYLE 'BORDER: 0.5PT SOLID WINDOWTEXT;' INTO STYLE.
IF LEFT <> 'X'.
CONCATENATE STYLE 'BORDER-LEFT: NONE;' INTO STYLE.
ENDIF.
IF TOP <> 'X'.
CONCATENATE STYLE 'BORDER-TOP: NONE;' INTO STYLE.
ENDIF.
IF RIGHT <> 'X'.
CONCATENATE STYLE 'BORDER-RIGHT: NONE;' INTO STYLE.
ENDIF.
IF BOTTOM <> 'X'.
CONCATENATE STYLE 'BORDER-BOTTOM: NONE;' INTO STYLE.
ENDIF.
ENDFORM.
FORM GET_STYLE USING TDST TYPE Y96XL_TD_STYLE STYLE_STR STYLE.
IF NOT STYLE_STR IS INITIAL.
TRANSLATE STYLE_STR TO UPPER CASE.
READ TABLE ITSS WITH KEY STR = STYLE_STR BINARY SEARCH.
IF SY-SUBRC <> 0.
ADD 1 TO STYLE_STR_INDEX.
ITSS-INDEX = STYLE_STR_INDEX.
ITSS-STR = STYLE_STR.
APPEND ITSS.
ENDIF.
ELSE.
CLEAR ITSS-INDEX.
ENDIF.
READ TABLE ITS WITH KEY SID = TDST-SID
LEFT = TDST-LEFT
TOP = TDST-TOP
RIGHT = TDST-RIGHT
BOTTOM = TDST-BOTTOM
ALIGN = TDST-ALIGN
GS = TDST-GS
DECS = TDST-DECS
XTYP = TDST-XTYP
IGCPN = TDST-IGCPN
SSINDEX = ITSS-INDEX
BINARY SEARCH.
IF SY-SUBRC <> 0.
ADD 1 TO STYLE_INDEX.
ITS = TDST.
ITS-SSINDEX = ITSS-INDEX.
ITS-INDEX = STYLE_INDEX.
WRITE STYLE_INDEX TO ITS-STYLE LEFT-JUSTIFIED NO-GROUPING.
CONCATENATE 'S' ITS-STYLE INTO ITS-STYLE.
INSERT ITS INDEX SY-TABIX.
ENDIF.
STYLE = ITS-STYLE.
ENDFORM.
FORM READ_LINE USING INDEX LI LAST.
DO.
ADD 1 TO INDEX.
READ TABLE ITLI INDEX INDEX.
IF SY-SUBRC <> 0.
LAST = 'X'.
EXIT.
ELSE.
LI = ITLI.
READ TABLE ITL INDEX ITLI-INDEX.
IF ITL-EXLUD <> 'X'. EXIT. ENDIF.
ENDIF.
ENDDO.
ENDFORM.
* Построение HTMLя
FORM BUILD_BODY TABLES LIST TYPE SLIST_LIST_TAB
FMBX TYPE SLIST_FMBS_TAB
HIDE TYPE SLIST_HIDE_TAB
HDLN TYPE SLIST_HIDELINE_TAB.
DATA: HLINE(1023) TYPE C.
DATA: NEXT_INDEX TYPE I.
DATA: NEXT_LIST TYPE SLIST_LISTLINE.
DATA: PLINE LIKE LIST-LINE.
DATA: NLI LIKE LINE OF ITLI.
DATA: CLI LIKE LINE OF ITLI.
DATA: PLI LIKE LINE OF ITLI.
DATA: LAST TYPE C.
DATA: CANCEL TYPE C.
DATA: COLSPAN_COUNT TYPE I.
DATA: COL TYPE I,
WIDTH TYPE I,
CWIDTH(5) TYPE C.
DATA: ROWS_TOTAL TYPE I.
PERFORM BUILD_TAG USING ''.
PERFORM BUILD_TAG USING '
'.
* Установка ширины столбцов
CLEAR HLINE.
LOOP AT ITCOL WHERE WIDTH > 0.
WIDTH = ITCOL-WIDTH * CHAR_WIDTH_P + CHAR_WIDTH_P_D.
ADD 1 TO COL.
* PERFORM on_col_width USING ' ' col itcol-width width.
WRITE WIDTH TO CWIDTH LEFT-JUSTIFIED NO-GROUPING.
CONCATENATE HLINE '
'
INTO HLINE.
ENDLOOP.
PERFORM ADD_TEXT USING HLINE.
* Постороение таблицы
PERFORM READ_LINE USING NEXT_INDEX CLI LAST.
IF LAST = 'X'.
MESSAGE S012.
EXIT.
ENDIF.
READ TABLE LIST INDEX NEXT_INDEX.
PERFORM CONVERT_LINE_BY_FMBX TABLES FMBX USING LIST.
DO.
PERFORM READ_LINE USING NEXT_INDEX NLI LAST.
IF LAST = 'X'.
CLEAR: NEXT_LIST, NLI.
ELSE.
READ TABLE LIST INTO NEXT_LIST INDEX NEXT_INDEX.
PERFORM CONVERT_LINE_BY_FMBX TABLES FMBX USING NEXT_LIST.
ENDIF.
READ TABLE ITL INDEX CLI-INDEX.
IF CLI-COULN = 'X' AND ( PLI-VLINE = 'X' OR NLI-VLINE = 'X' ).
ELSE.
IF LIST-LENG = 0.
PERFORM ADD_TEXT USING '
'.
ELSE.
G_ROW = NEXT_INDEX - 1.
CLEAR: CANCEL, HLINE.
* PERFORM call_on_row TABLES hide hdln
* USING g_row list-hide list-line(list-leng)
* CHANGING hline+1(1022) cancel.
IF CANCEL <> 'X'.
ADD ITL-COLSPAN_COUNT TO COLSPAN_COUNT. " Глюк в Excel-е
IF SCR-NOTCOLSPAN <> 'X' AND COLSPAN_COUNT >= 32760.
XLS_PREPARE_COL_WIDTH = 'X'.
CLEAR COLSPAN_COUNT.
PERFORM ADD_TEXT USING '
'.
PERFORM BUILD_TAG USING '
'.
ENDIF.
SHIFT HLINE RIGHT BY 1 PLACES.
CONCATENATE '' INTO HLINE.
PERFORM ADD_TEXT USING HLINE.
PERFORM BUILD_LINE USING PLI-ULINE PLINE
LIST-LINE
NLI-ULINE NEXT_LIST-LINE.
PERFORM ADD_STR USING ''.
ADD 1 TO ROWS_TOTAL.
ENDIF.
ENDIF.
ENDIF.
IF LAST = 'X'. EXIT. ENDIF.
PLINE = LIST-LINE.
LIST = NEXT_LIST.
PLI = CLI.
CLI = NLI.
ENDDO.
PERFORM ADD_TEXT USING '
'.
IF ROWS_TOTAL > 65536.
MESSAGE I013 WITH ROWS_TOTAL.
ENDIF.
ENDFORM.
FORM BUILD_LINE USING PLI PLINE LINE NLI NLINE.
DATA: VALUE(1023) TYPE C.
DATA: HLINE(1023) TYPE C.
DATA: COLSPAN(15) TYPE C,
XCOLSPAN TYPE I,
STYLE(15) TYPE C.
DATA: TDST TYPE Y96XL_TD_STYLE.
DATA: LEN TYPE I.
DATA: FORMAT_OFF TYPE C.
DATA: COL TYPE I.
DATA: STYLE_STR(1000) TYPE C,
IN_TAG(1000) TYPE C,
BEFORE_VAL(1000) TYPE C,
AFTER_VAL(1000) TYPE C.
FIELD-SYMBOLS .
LOOP AT ITL-ITD INTO DM.
CLEAR: TDST, FORMAT_OFF, STYLE, COLSPAN,
STYLE_STR, IN_TAG, BEFORE_VAL, AFTER_VAL.
IF DM-COLSPAN > 0 AND SCR-NOTCOLSPAN <> 'X'.
XCOLSPAN = DM-COLSPAN + 1.
WRITE XCOLSPAN TO COLSPAN LEFT-JUSTIFIED NO-GROUPING.
CONCATENATE ' COLSPAN=' COLSPAN INTO COLSPAN.
ENDIF.
IF DM-ID = VLX.
CLEAR VALUE.
ELSE.
VALUE = LINE+DM-POS(DM-LEN).
IF DM-UNITED = 'X'.
TDST-DECS = 'T'.
TDST-ALIGN = 'L'.
PERFORM VALUE_PREPARE USING VALUE(DM-LEN).
ELSE.
TDST-XTYP = DM-XTYP.
CASE DM-XTYP.
WHEN SLIST_FMBX_CHECKBOX.
PERFORM MAKE_CHECKBOX USING VALUE TDST-XTYP.
WHEN SLIST_FMBX_SYMBOL.
PERFORM MAKE_SYMBOL USING VALUE TDST-XTYP.
WHEN SLIST_FMBX_ICON.
PERFORM MAKE_ICON USING VALUE TDST-XTYP.
ENDCASE.
IF TDST-XTYP IS INITIAL.
PERFORM ANALIZE_ALIGN
USING VALUE(DM-LEN) DM-LEN TDST-ALIGN.
PERFORM ANALIZE_NUMBERS
USING VALUE(DM-LEN) TDST-DECS TDST-GS.
PERFORM VALUE_PREPARE
USING VALUE(DM-LEN).
ENDIF.
ENDIF.
ENDIF.
IF XLSHTML = 'X' AND VALUE IS INITIAL.
VALUE = ' '.
ENDIF.
IF FORMAT_OFF <> 'X'
AND SCR-BORDER_OFF <> 'X'
AND ( PLI = 'X' OR NLI = 'X' ).
LEN = DM-END - DM-BGN + 1.
IF PLI = 'X'.
ASSIGN PLINE+DM-BGN(LEN) TO .
IF CO CH_LINE. TDST-TOP = 'X'. ENDIF.
ENDIF.
IF NLI = 'X'.
ASSIGN NLINE+DM-BGN(LEN) TO .
IF CO CH_LINE. TDST-BOTTOM = 'X'. ENDIF.
ENDIF.
ENDIF.
IF FORMAT_OFF <> 'X' AND SCR-COLOR_OFF <> 'X'.
TDST-SID = DM-SID.
ENDIF.
IF SCR-BORDER_OFF <> 'X'.
TDST-LEFT = DM-VLINE.
TDST-RIGHT = DM-RVLINE.
ENDIF.
IF DM-COLSPAN > 0 AND SCR-NOTCOLSPAN = 'X'.
TDST-IGCPN = 'X'.
ENDIF.
* PERFORM call_on_cell USING col value tdst
* CHANGING style_str in_tag+1(999)
* before_val after_val.
PERFORM GET_STYLE USING TDST STYLE_STR STYLE.
CONCATENATE ' CLASS=' STYLE INTO STYLE.
CONCATENATE HLINE ''
BEFORE_VAL VALUE AFTER_VAL ''
INTO HLINE.
PERFORM ADD_STR USING HLINE.
CLEAR HLINE.
IF TDST-IGCPN = 'X'.
IF XLSHTML = 'X'. COLSPAN = ' '. ENDIF.
IF TDST-LEFT = 'X'.
CLEAR: TDST-LEFT, TDST-RIGHT.
PERFORM GET_STYLE USING TDST STYLE_STR STYLE.
CONCATENATE ' CLASS=' STYLE INTO STYLE.
ENDIF.
DO DM-COLSPAN TIMES.
IF SY-INDEX = DM-COLSPAN
AND DM-RVLINE = 'X'.
TDST-RIGHT = 'X'.
PERFORM GET_STYLE USING TDST STYLE_STR STYLE.
CONCATENATE ' CLASS=' STYLE INTO STYLE.
ENDIF.
CONCATENATE HLINE '' COLSPAN '' INTO HLINE.
ENDDO.
PERFORM ADD_STR USING HLINE.
CLEAR HLINE.
ENDIF.
COL = COL + 1 + DM-COLSPAN.
ENDLOOP.
ENDFORM.
FORM CHECK_XMODE USING XMODE VAL XTYP.
SY-SUBRC = 4.
CASE XMODE.
WHEN '-'. CLEAR: VAL, XTYP.
WHEN 'T'. CLEAR XTYP.
WHEN 'X'. CLEAR SY-SUBRC.
ENDCASE.
ENDFORM.
FORM MAKE_SYMBOL USING VAL XTYP.
PERFORM CHECK_XMODE USING SCR-SYMBOL_MODE VAL XTYP.
ENDFORM.
FORM MAKE_CHECKBOX USING VAL XTYP.
PERFORM CHECK_XMODE USING SCR-CHECKBOX_MODE VAL XTYP.
CHECK SY-SUBRC = 0.
IF VAL IS INITIAL.
VAL = ''.
ELSE.
VAL = ''.
ENDIF.
ENDFORM.
FORM MAKE_ICON USING VAL XTYP.
DATA: ID(4) VALUE '@@@@'.
DATA: RETV(255) TYPE C.
STATICS: BEGIN OF ITICON OCCURS 0,
ID LIKE ICON-ID,
INTERNAL LIKE ICON-INTERNAL,
NAME LIKE ICON-NAME,
END OF ITICON.
PERFORM CHECK_XMODE USING SCR-ICON_MODE VAL XTYP.
CHECK SY-SUBRC = 0.
IF ITICON[] IS INITIAL.
SELECT ID INTERNAL NAME INTO TABLE ITICON FROM ICON.
SORT ITICON BY ID.
ENDIF.
DO.
IF VAL IS INITIAL. EXIT. ENDIF.
SHIFT VAL LEFT DELETING LEADING SPACE.
ID+1(2) = VAL(2).
READ TABLE ITICON WITH KEY ID = ID BINARY SEARCH.
CHECK SY-SUBRC = 0.
ITICONS-INTERNAL = ITICON-INTERNAL+1(6).
ITICONS-NAME = ITICON-NAME.
COLLECT ITICONS.
CONCATENATE RETV '' INTO RETV.
SHIFT VAL BY 2 PLACES.
ENDDO.
VAL = RETV.
ENDFORM.
FORM INIT.
DATA: DCPFM LIKE USR01-DCPFM.
DATA: BEGIN OF ITTPX OCCURS 0,
ID TYPE C,
KEY(3) TYPE C,
SKIP(5) TYPE C,
TEXT(132) TYPE C,
END OF ITTPX.
CLEAR XLSHTML.
CHECK GINIT <> 'X'.
GINIT = 'X'.
CH_LINE(1) = SY-ULINE(1).
CH_LINE+1(1) = SY-VLINE.
READ TEXTPOOL SY-REPID INTO ITTPX.
LOOP AT ITTPX WHERE ID = 'I'.
ITTP-KEY = ITTPX-KEY.
ITTP-TEXT = ITTPX-TEXT.
APPEND ITTP.
ENDLOOP.
SELECT SINGLE DATFM DCPFM
INTO (DATFMT, DCPFM)
FROM USR01
WHERE BNAME = SY-UNAME.
IF DCPFM = 'X'.
DCS = '.'. NGS = ','.
ELSE.
DCS = ','. NGS = '.'.
ENDIF.
GSTRANSLATE(1) = NGS.
CALL FUNCTION 'WS_QUERY'
EXPORTING
QUERY = 'CD'
IMPORTING
RETURN = PROGRAM_DIR
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
PERFORM GET_CODE_PAGES.
ENDFORM.
FORM GET_CODE_PAGES.
* Скопировано из SAPLSLST - build_codepage_conversion
CALL 'CUR_LCL' ID 'CODEPAGE' FIELD SRC_CODEPAGE.
CASE SRC_CODEPAGE. " set the appropriate Windows codepage and font
WHEN '1401'. " central europe (czech, serbocroatian, ...)
DST_CODEPAGE = '1404'.
WHEN '1500'. " cyrillic (russian, bulgarian, ...)
DST_CODEPAGE = '1504'.
WHEN '1610'. " turkish
DST_CODEPAGE = '1614'.
WHEN '1700'. " greek
DST_CODEPAGE = '1704'.
WHEN '8000'. "Y4BK002896
DST_CODEPAGE = '8000'.
WHEN OTHERS. " ANSI english
DST_CODEPAGE = '1133'.
ENDCASE.
ENDFORM.
FORM GET_TABLE_STYLE USING SLINE.
CONCATENATE 'TABLE {FONT-FAMILY:"' FONT_FAMILY '";'
'MSO-DISPLAYED-DECIMAL-SEPARATOR:"\' DCS '";'
'MSO-DISPLAYED-THOUSAND-SEPARATOR:"\' NGS'";}'
INTO SLINE.
ENDFORM.
FORM GET_TR_STYLE USING SLINE.
CONCATENATE 'TR {VERTICAL-ALIGN:MIDDLE; HEIGHT:' ROW_HEIGHT 'PT}'
INTO SLINE.
ENDFORM.
FORM BUILD_STYLE.
DATA: SLINE(1000) TYPE C.
DATA: LEN TYPE I,
CH TYPE C.
PERFORM BUILD_TAG USING ''.
ENDFORM.
FORM GET_XTYP_STYLE USING XTYP SLINE.
CASE ITS-XTYP.
WHEN FMBX_OFF.
WHEN SLIST_FMBX_CHECKBOX.
WHEN SLIST_FMBX_SYMBOL.
CONCATENATE SLINE
'FONT-FAMILY:SAPDings, MONOSPACE; MSO-FONT-CHARSET:2;'
INTO SLINE.
WHEN SLIST_FMBX_ICON.
ENDCASE.
ENDFORM.
FORM ADD_STR USING TEXT.
PERFORM ADD_TEXT_ USING TEXT SPACE.
ENDFORM.
FORM ADD_TEXT USING TEXT.
PERFORM ADD_TEXT_ USING TEXT RET.
ENDFORM.
FORM ADD_TEXT_ USING TEXT SEPARATOR.
DATA: LEN TYPE I.
* WRITE: / text.
CONCATENATE BTEXT SEPARATOR TEXT INTO BTEXT.
LEN = STRLEN( BTEXT ).
DO.
IF LEN <= 255. EXIT. ENDIF.
TRANSLATE BTEXT(255)
FROM CODE PAGE SRC_CODEPAGE
TO CODE PAGE DST_CODEPAGE.
APPEND BTEXT(255) TO .
SHIFT BTEXT BY 255 PLACES.
SUBTRACT 255 FROM LEN.
ENDDO.
ENDFORM.
FORM OPEN_BUFER USING BUF.
ASSIGN BUF TO .
REFRESH .
CLEAR BTEXT.
ENDFORM.
FORM CLOSE_BUFER.
TRANSLATE BTEXT(255)
FROM CODE PAGE SRC_CODEPAGE
TO CODE PAGE DST_CODEPAGE.
APPEND BTEXT(255) TO .
ENDFORM.
FORM ANALIZE_ALIGN USING VAL TYPE C LEN ALIGN.
DATA: LEN1 TYPE I,
LEN2 TYPE I,
LENX TYPE I,
DL TYPE I.
DATA: CH TYPE C.
CH = VAL(1).
IF CH <> SPACE.
ALIGN = 'L'.
ELSE.
LENX = LEN - 1.
CH = VAL+LENX.
IF CH <> SPACE.
ALIGN = 'R'.
SHIFT VAL LEFT DELETING LEADING SPACE.
ELSE.
LENX = STRLEN( VAL ).
SHIFT VAL LEFT DELETING LEADING SPACE.
LEN2 = STRLEN( VAL ).
LEN1 = LENX - LEN2.
LEN2 = LEN - LENX.
DL = LEN2 - LEN1.
IF DL BETWEEN -1 AND 1.
ALIGN = 'C'.
ELSE.
CLEAR ALIGN.
SHIFT VAL RIGHT BY LEN1 PLACES.
ENDIF.
ENDIF.
ENDIF.
ENDFORM.
FORM VALUE_PREPARE USING VAL.
DATA: LEN TYPE I.
FIELD-SYMBOLS TYPE C.
LEN = STRLEN( VAL ).
CHECK LEN > 0.
ASSIGN VAL(LEN) TO .
TRANSLATE USING XLS_SPACE_TRANSLATE.
TRANSLATE USING '<{>}'.
ENDFORM.
* Ну никак у меня не получилось получит тип переменной - всё перепробова
* Да в общемто так оно и лучше (наверно)
FORM ANALIZE_NUMBERS USING VAL TYPE C ADEC AGS.
DATA: POS TYPE I,
LEN TYPE I.
DATA: S1(10) TYPE C,
S2(10) TYPE C,
S3(10) TYPE C.
DATA: CH TYPE C.
DATA: MINUS TYPE C.
DATA: ITGS(5) TYPE C OCCURS 0 WITH HEADER LINE.
DATA: GSSTR(10) TYPE C.
FIELD-SYMBOLS .
ADEC = 'T'. " Текст пока не доказано обратного дабы Excel не напутал
CHECK VAL CA '0123456789'.
POS = SY-FDPOS.
CHECK VAL CO '0123456789.,- '.
LEN = STRLEN( VAL ) - POS.
ASSIGN VAL+POS(LEN) TO .
CHECK NA ' '. " Нет пробелов внутри числа
IF CA '-'. " Если имеется минус то проверяем что он в конце числа
ADD 1 TO SY-FDPOS.
CHECK SY-FDPOS = LEN.
MINUS = 'X'.
ENDIF.
SHIFT VAL LEFT DELETING LEADING SPACE.
SPLIT VAL AT DCS INTO S1 S2 S3.
CHECK S3 IS INITIAL AND S2 NA NGS. " Раз. дробн. части один....
ADEC = STRLEN( S2 ).
IF ADEC = '0' AND LEN > 1.
CH = VAL(1).
IF CH = '0'.
ADEC = 'T'.
ENDIF.
ENDIF.
TRANSLATE ADEC USING '*T'. " Кол-во знаков после запятой больше 9
IF MINUS = 'X'.
SUBTRACT 1 FROM LEN.
VAL+LEN(1) = SPACE.
SHIFT VAL RIGHT.
VAL(1) = '-'.
IF ADEC <> '0'.
SUBTRACT 1 FROM ADEC.
ENDIF.
ENDIF.
CHECK S1 CA NGS. " Содержит разделители групп разрядов
SPLIT S1 AT NGS INTO TABLE ITGS.
LOOP AT ITGS.
CH = STRLEN( ITGS ).
GSSTR+SY-TABIX(1) = CH.
ENDLOOP.
SHIFT GSSTR.
IF DATFMT CA '14' AND NGS = '.' " А не дата ли
AND ADEC CA 'T0'
AND MINUS = ' '
AND ( ( DATFMT = '1' AND GSSTR = '224' )
OR ( DATFMT = '4' AND GSSTR = '422' ) ).
ADEC = 'D'.
ENDIF.
CHECK ADEC NA 'TD'.
IF GSSTR(1) <= '3' AND GSSTR+1 CO '3 '.
TRANSLATE VAL USING GSTRANSLATE.
CONDENSE VAL NO-GAPS.
AGS = 'X'.
ELSE.
ADEC = 'T'.
ENDIF.
ENDFORM.
FORM GET_NUMBER USING DECS GS STYLE.
DATA: ZEROS(10) TYPE N,
FORMAT(15) TYPE C.
CHECK NOT DECS IS INITIAL.
CASE DECS.
WHEN '0'.
FORMAT = '0'.
WHEN 'T'.
FORMAT = '\@'.
WHEN 'D'.
FORMAT = 'SHORT DATE'.
WHEN OTHERS.
FORMAT = '0\.'.
FORMAT+3 = ZEROS(DECS).
ENDCASE.
IF GS = 'X'.
CONCATENATE '\#\,\#\#' FORMAT INTO FORMAT.
ENDIF.
CONCATENATE STYLE 'MSO-NUMBER-FORMAT:"' FORMAT '";' INTO STYLE.
ENDFORM.
FORM GET_ALIGN USING ALIGN STYLE.
DATA: XALIGN(10) TYPE C.
CASE ALIGN.
WHEN 'L'. XALIGN = 'LEFT'.
WHEN 'R'. XALIGN = 'RIGHT'.
WHEN 'C'. XALIGN = 'CENTER'.
WHEN OTHERS.
EXIT.
ENDCASE.
CONCATENATE STYLE 'TEXT-ALIGN:' XALIGN ';' INTO STYLE.
ENDFORM.
FORM GET_HTML
TABLES LIST TYPE SLIST_LIST_TAB
FMBS TYPE SLIST_FMBS_TAB
FMBX TYPE SLIST_FMBS_TAB
FSEL TYPE SLIST_FSEL_TAB
FIDO TYPE SLIST_FIDO_TAB
HIDE TYPE SLIST_HIDE_TAB
HDLN TYPE SLIST_HIDELINE_TAB.
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
TEXT = 'Подготовка данных для Excel-я'
EXCEPTIONS
OTHERS = 1.
PERFORM HTML_INIT.
PERFORM ANALIZE_LIST TABLES LIST FMBX.
PERFORM ANALIZE_FMBS TABLES LIST FMBS.
PERFORM ANALIZE_FMBX TABLES LIST FMBX.
PERFORM ANALIZE_FIDO TABLES FIDO.
PERFORM ANALIZE_FSEL TABLES FSEL.
CHECK BREAK IS INITIAL.
PERFORM BUILD_HTML TABLES LIST FMBX HIDE HDLN.
ENDFORM.
FORM BUILD_HTML TABLES LIST TYPE SLIST_LIST_TAB
FMBX TYPE SLIST_FMBS_TAB
HIDE TYPE SLIST_HIDE_TAB
HDLN TYPE SLIST_HIDELINE_TAB.
* PERFORM on_start USING char_width_p
* char_width_p_d
* char_width_x
* char_width_x_d
* row_height font_family.
PERFORM OPEN_BUFER USING HBUFER.
PERFORM BUILD_BODY TABLES LIST FMBX HIDE HDLN.
PERFORM ADD_TEXT USING ''.
PERFORM CLOSE_BUFER.
PERFORM OPEN_BUFER USING SBUFER.
PERFORM BUILD_TAG USING ''.
PERFORM BUILD_TAG USING ''.
PERFORM BUILD_TAG USING ''.
PERFORM BUILD_STYLE.
PERFORM BUILD_TAG USING ''.
PERFORM ADD_TEXT USING ''.
PERFORM CLOSE_BUFER.
INSERT LINES OF SBUFER INTO HBUFER INDEX 1.
FREE SBUFER.
ASSIGN HBUFER TO .
ENDFORM.
FORM BUILD_TAG USING TAGNAME.
DATA: TAGCP(3) TYPE C.
DATA: ITTAG(132) TYPE C OCCURS 0 WITH HEADER LINE.
CASE TAGNAME.
WHEN ''. TAGCP = 'HT+'.
WHEN ''. TAGCP = 'MT+'.
WHEN ''. TAGCP = 'XM+'.
ENDCASE.
IF NOT TAGCP IS INITIAL.
LOOP AT ITTP WHERE KEY CP TAGCP.
APPEND ITTP-TEXT TO ITTAG.
ENDLOOP.
ENDIF.
* PERFORM on_tag TABLES ittag USING tagname.
IF ITTAG[] IS INITIAL.
APPEND TAGNAME TO ITTAG.
ENDIF.
LOOP AT ITTAG.
IF SY-TABIX = 1 AND TAGNAME = ''.
PERFORM ADD_STR USING ITTAG.
ELSE.
PERFORM ADD_TEXT USING ITTAG.
ENDIF.
ENDLOOP.
ENDFORM.
FORM HTML_INIT.
CLEAR: BTEXT, STYLE_INDEX, STYLE_STR_INDEX, XLS_PREPARE_COL_WIDTH,
LIST_WIDTH, BREAK, DM.
REFRESH: ITCOL, ITF, ITLI, ITL, ITLP, ITS, ITID, ITX,
HBUFER, SBUFER.
ENDFORM.
FORM ANALIZE_FIDO TABLES FIDO TYPE SLIST_FIDO_TAB.
CHECK NOT ITV[] IS INITIAL.
LOOP AT FIDO.
ITID-ID = SY-TABIX.
READ TABLE ITV WITH KEY OFFI = FIDO-OFFI
OFSG = FIDO-OFSG
BINARY SEARCH.
CHECK SY-SUBRC = 0.
ITID-INDEX = SY-TABIX.
APPEND ITID.
ENDLOOP.
ENDFORM.
FORM SAVE_AS_EXCEL USING FILENAME NOT_CLOSE.
DATA: HTMLFILE LIKE RLGRAP-FILENAME,
OK TYPE C,
CLOSE TYPE C.
PERFORM GET_TEMP_FILENAME USING PROGRAM_DIR '.HTM' HTMLFILE.
PERFORM SAVE_HTML USING HTMLFILE.
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
TEXT = 'Данные переданы теперь дело за Excel-ем'
EXCEPTIONS
OTHERS = 1.
PERFORM RUN_EXCEL USING HTMLFILE FILENAME OK.
CALL FUNCTION 'WS_FILE_DELETE'
EXPORTING
FILE = HTMLFILE
EXCEPTIONS
OTHERS = 1.
IF OK <> 'X'.
PERFORM FREE_EXCEL USING 'X'.
MESSAGE E003.
ENDIF.
IF NOT_CLOSE = 'X'.
SET PROPERTY OF H_APPL 'VISIBLE' = 1.
ELSE.
CLOSE = 'X'.
ENDIF.
PERFORM FREE_EXCEL USING CLOSE.
ENDFORM.
FORM FREE_EXCEL USING CLOSE.
IF CLOSE = 'X'.
CALL METHOD OF H_APPL 'QUIT'.
ENDIF.
FREE OBJECT H_SHEET.
FREE OBJECT H_WORK.
FREE OBJECT H_BOOKS.
FREE OBJECT H_APPL.
ENDFORM.
FORM RUN_EXCEL USING HTMLFILE XLSFILE OK.
DATA: H_RANGE TYPE OLE2_OBJECT.
DATA: COL TYPE I.
DATA: WIDTH TYPE I.
CLEAR OK.
CREATE OBJECT H_APPL 'EXCEL.APPLICATION'.
CHECK SY-SUBRC = 0.
CALL METHOD OF H_APPL 'WORKBOOKS' = H_BOOKS.
CHECK SY-SUBRC = 0.
CALL METHOD OF H_BOOKS 'OPEN'
EXPORTING #1 = HTMLFILE.
CHECK SY-SUBRC = 0.
CALL METHOD OF H_APPL 'ACTIVEWORKBOOK' = H_WORK.
IF SY-SUBRC <> 0. EXIT. ENDIF.
CALL METHOD OF H_APPL 'ActiveSheet' = H_SHEET.
IF SY-SUBRC <> 0. EXIT. ENDIF.
IF XLS_PREPARE_COL_WIDTH = 'X'.
LOOP AT ITCOL WHERE WIDTH > 0.
WIDTH = ITCOL-WIDTH * CHAR_WIDTH_X + CHAR_WIDTH_X_D.
ADD 1 TO COL.
* PERFORM on_col_width USING 'X' col itcol-width width.
CALL METHOD OF H_SHEET 'Columns' = H_RANGE
EXPORTING #1 = COL.
IF SY-SUBRC = 0.
SET PROPERTY OF H_RANGE 'ColumnWidth' = WIDTH.
ENDIF.
ENDLOOP.
ENDIF.
CALL METHOD OF H_WORK 'SAVEAS'
EXPORTING #1 = XLSFILE
#2 = -4143. " xlNormal
CHECK SY-SUBRC = 0.
OK = 'X'.
* PERFORM on_excel USING h_appl h_books h_work h_sheet.
ENDFORM.
FORM SAVE_HTML USING AFILENAME.
DATA: FILENAME LIKE RLGRAP-FILENAME,
FSIZE TYPE I,
POS TYPE I.
FILENAME = AFILENAME.
DESCRIBE TABLE .
FSIZE = SY-TFILL * 255.
PERFORM FILE_DOWNLOAD TABLES
USING FILENAME FSIZE.
IF SY-SUBRC <> 0.
MESSAGE E002 WITH SY-SUBRC.
ENDIF.
PERFORM GET_LAST_POS_OF_CHAR USING FILENAME '\' 0 POS.
PERFORM SAVE_ICONS USING FILENAME(POS).
ENDFORM.
FORM GET_LAST_POS_OF_CHAR USING ASTR CH BPOS POS.
DATA: LEN TYPE I.
DATA: STR(200) TYPE C.
FIELD-SYMBOLS .
STR = ASTR.
CLEAR POS.
LEN = STRLEN( STR ) - BPOS.
CHECK LEN > 0.
ASSIGN STR+BPOS(LEN) TO .
DO.
IF CA CH.
ADD 1 TO SY-FDPOS.
SUBTRACT SY-FDPOS FROM LEN.
IF LEN <= 0. EXIT. ENDIF.
ASSIGN +SY-FDPOS(LEN) TO .
ADD SY-FDPOS TO POS.
ELSE.
EXIT.
ENDIF.
ENDDO.
ENDFORM.
* Сохраняем файлы иконок
* В 4.7 всё это можно и надо-бы сделать по другому
FORM SAVE_ICONS USING HTML_DIR.
DATA: FNAME LIKE RLGRAP-FILENAME,
RETURN TYPE C,
NOTQ TYPE C.
DATA: H_COM TYPE OLE2_OBJECT.
DATA: RESULT TYPE I.
DATA: KEY LIKE WWWDATATAB.
DATA: BEGIN OF ITCOPY OCCURS 0,
INTERNAL LIKE ICON-INTERNAL,
FNAME LIKE RLGRAP-FILENAME,
END OF ITCOPY.
DATA: ICOUNT TYPE I,
FCOUNT TYPE I.
CHECK SCR-ICON_MODE = 'X'.
CREATE OBJECT H_COM 'SAPINFO'.
IF SY-SUBRC <> 0. EXIT. ENDIF.
CONCATENATE PROGRAM_DIR '\' SAP_ICONS_DIR INTO FNAME.
CALL FUNCTION 'WS_QUERY'
EXPORTING
FILENAME = FNAME
QUERY = 'DE'
IMPORTING
RETURN = RETURN
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
IF SY-SUBRC <> 0. EXIT. ENDIF.
IF RETURN = '0'.
CALL METHOD OF H_COM 'CreateDirectory' = RESULT
EXPORTING #1 = FNAME.
IF SY-SUBRC <> 0
OR ( RESULT <> 0 AND RESULT <> 183 ).
EXIT.
ENDIF.
NOTQ = 'X'.
ENDIF.
LOOP AT ITICONS.
ITCOPY-INTERNAL = ITICONS-INTERNAL.
CONCATENATE PROGRAM_DIR SAP_ICONS_DIR '\' ITICONS-INTERNAL
'.GIF'
INTO ITCOPY-FNAME.
IF NOTQ <> 'X'.
CALL FUNCTION 'WS_QUERY'
EXPORTING
FILENAME = ITCOPY-FNAME
QUERY = 'FE'
IMPORTING
RETURN = RETURN
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
IF SY-SUBRC <> 0. EXIT. ENDIF.
IF RETURN = '1'.
APPEND ITCOPY.
CONTINUE.
ENDIF.
ENDIF.
KEY-RELID = 'MI'.
CONCATENATE 'Y96_' ITICONS-NAME INTO KEY-OBJID.
CONCATENATE SAP_ICONS_DIR '\' ITICONS-INTERNAL INTO ITCOPY-FNAME.
SELECT SINGLE OBJID INTO KEY-OBJID
FROM WWWPARAMS
WHERE RELID = KEY-RELID
AND OBJID = KEY-OBJID.
CHECK SY-SUBRC = 0. " Ато оно в дамп падает
CALL FUNCTION 'DOWNLOAD_WEB_OBJECT'
EXPORTING
KEY = KEY
CHANGING
TEMP = ITCOPY-FNAME
EXCEPTIONS
OTHERS = 1.
CHECK SY-SUBRC = 0.
APPEND ITCOPY.
ENDLOOP.
DESCRIBE TABLE ITICONS LINES ICOUNT.
DESCRIBE TABLE ITCOPY LINES FCOUNT.
IF ICOUNT > FCOUNT.
MESSAGE S010.
ENDIF.
CHECK HTML_DIR <> PROGRAM_DIR.
CONCATENATE HTML_DIR SAP_ICONS_DIR INTO FNAME.
CALL FUNCTION 'WS_QUERY'
EXPORTING
FILENAME = FNAME
QUERY = 'DE'
IMPORTING
RETURN = RETURN
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
IF SY-SUBRC <> 0. EXIT. ENDIF.
IF RETURN = '0'.
CALL METHOD OF H_COM 'CreateDirectory' = RESULT
EXPORTING #1 = FNAME.
IF SY-SUBRC <> 0
OR ( RESULT <> 0 AND RESULT <> 183 ).
EXIT.
ENDIF.
ENDIF.
LOOP AT ITCOPY.
CONCATENATE HTML_DIR '\' SAP_ICONS_DIR '\' ITCOPY-INTERNAL '.GIF'
INTO FNAME.
CALL FUNCTION 'WS_FILE_COPY'
EXPORTING
DESTINATION = FNAME
SOURCE = ITCOPY-FNAME
EXCEPTIONS
OTHERS = 1.
ENDLOOP.
ENDFORM.
FORM SAVE_FILE USING FILENAME EXEC.
DATA: DPOS TYPE I.
DATA: EPOS TYPE I.
DATA: POS TYPE I.
DATA: EXT(10) TYPE C.
CHECK BREAK IS INITIAL.
* PERFORM kde_about USING '05'.
PERFORM GET_LAST_POS_OF_CHAR USING FILENAME '\' 0 DPOS.
PERFORM GET_LAST_POS_OF_CHAR USING FILENAME '.' DPOS EPOS.
IF EPOS > 0.
POS = DPOS + EPOS - 1.
EXT = FILENAME+POS.
ELSE.
EXT = XLSEXT.
ENDIF.
IF EPOS <= 1.
IF DPOS > 0.
PERFORM GET_TEMP_FILENAME USING FILENAME(DPOS) EXT FILENAME.
ELSE.
PERFORM GET_TEMP_FILENAME USING PROGRAM_DIR EXT FILENAME.
ENDIF.
ENDIF.
IF EXT = XLSEXT.
PERFORM SAVE_AS_EXCEL USING FILENAME EXEC.
ELSE.
PERFORM SAVE_HTML USING FILENAME.
IF EXEC = 'X'.
CALL FUNCTION 'WS_EXECUTE'
EXPORTING
PROGRAM = FILENAME
EXCEPTIONS
FRONTEND_ERROR = 1
NO_BATCH = 2
PROG_NOT_FOUND = 3
ILLEGAL_OPTION = 4
GUI_REFUSE_EXECUTE = 5
OTHERS = 6.
ENDIF.
ENDIF.
ENDFORM.
FORM CONFIRM_FILENAME.
ENDFORM.
FORM GET_TEMP_FILENAME USING VALUE(DIR) EXT FILENAME.
DATA: NUM(5) TYPE C,
RETURN TYPE C.
CLEAR FILENAME.
DO.
IF SY-INDEX > 15.
CLEAR FILENAME. EXIT.
ENDIF.
WRITE SY-INDEX TO NUM LEFT-JUSTIFIED NO-GROUPING.
CONCATENATE DIR 'Y96LTEBHTMP' NUM EXT INTO FILENAME.
CALL FUNCTION 'WS_QUERY'
EXPORTING
FILENAME = FILENAME
QUERY = 'FE'
IMPORTING
RETURN = RETURN
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
IF SY-SUBRC <> 0.
CLEAR FILENAME. EXIT.
ENDIF.
IF RETURN = '0'. EXIT. ENDIF.
CALL FUNCTION 'WS_FILE_DELETE'
EXPORTING
FILE = FILENAME
IMPORTING
RETURN = RETURN
EXCEPTIONS
OTHERS = 1.
IF SY-SUBRC <> 0 OR RETURN = '9'.
CLEAR FILENAME. EXIT.
ENDIF.
IF RETURN = '0'. EXIT. ENDIF.
ENDDO.
IF FILENAME IS INITIAL.
MESSAGE E006.
ENDIF.
ENDFORM.
FORM CHECK_FILE_EXIST USING FILENAME.
DATA: RETURN TYPE C.
DATA: TEXTLINE1(132) TYPE C.
CALL FUNCTION 'WS_QUERY'
EXPORTING
FILENAME = FILENAME
QUERY = 'FE'
IMPORTING
RETURN = RETURN
EXCEPTIONS
INV_QUERY = 1
NO_BATCH = 2
FRONTEND_ERROR = 3
OTHERS = 4.
CHECK RETURN = '1'.
CASE XLSREWRITE.
WHEN 'C'.
CONCATENATE 'Файл:' FILENAME INTO TEXTLINE1 SEPARATED BY SPACE.
CALL FUNCTION 'POPUP_TO_CONFIRM_STEP'
EXPORTING
TEXTLINE1 = TEXTLINE1
TEXTLINE2 = 'существует. Перезаписать?'
TITEL = 'Перезаписать файл?'
CANCEL_DISPLAY = ' '
IMPORTING
ANSWER = RETURN
EXCEPTIONS
OTHERS = 1.
WHEN 'R'.
RETURN = 'J'.
WHEN OTHERS.
MESSAGE E011 WITH FILENAME.
ENDCASE.
CHECK RETURN = 'J'.
CALL FUNCTION 'WS_FILE_DELETE'
EXPORTING
FILE = FILENAME
IMPORTING
RETURN = RETURN
EXCEPTIONS
OTHERS = 1.
IF RETURN CA '89'.
MESSAGE E004 WITH FILENAME.
ENDIF.
ENDFORM.
MODULE EXIT_COMMAND INPUT.
CLEAR SCR-FNAME.
SY-SUBRC = 4.
LEAVE TO SCREEN 0.
ENDMODULE. " EXIT_COMMAND INPUT
FORM F4_FNAME.
CALL FUNCTION 'WS_FILENAME_GET'
EXPORTING
* def_filename = '.xls'
* def_path = 'c:\'
MASK = ',*.*,*.xls.'
MODE = 'S'
TITLE = 'Введите имя файла'
IMPORTING
FILENAME = PFNAME
EXCEPTIONS
INV_WINSYS = 1
NO_BATCH = 2
SELECTION_CANCEL = 3
SELECTION_ERROR = 4
OTHERS = 5.
ENDFORM.
FORM CHECK_FILE_EXT USING FILENAME.
DATA: DPOS TYPE I.
DATA: EPOS TYPE I.
DATA: POS TYPE I.
DATA: EXT(10) TYPE C.
PERFORM GET_LAST_POS_OF_CHAR USING FILENAME '\' 0 DPOS.
PERFORM GET_LAST_POS_OF_CHAR USING FILENAME '.' DPOS EPOS.
IF EPOS IS INITIAL.
CONCATENATE FILENAME XLSEXT INTO FILENAME.
MESSAGE S001 WITH XLSEXT.
CLEAR XLSHTML.
ELSE.
POS = DPOS + EPOS - 1.
EXT = FILENAME+POS.
IF EXT = XLSEXT.
CLEAR XLSHTML.
ELSE.
XLSHTML = 'X'.
ENDIF.
ENDIF.
ENDFORM.
FORM CHECK_FILE USING FILENAME.
CHECK NOT FILENAME IS INITIAL.
PERFORM CHECK_FILE_EXT USING FILENAME.
PERFORM CHECK_FILE_EXIST USING FILENAME.
ENDFORM.
FORM GET_VARIANTS.
DATA: ITX LIKE Y96LIST_TO_EXCEL.
SELECT * INTO ITX
FROM Y96LIST_TO_EXCEL.
IF ( ITX-CPROG IS INITIAL OR ITX-CPROG = SY-CPROG )
AND ( ITX-TCODE IS INITIAL OR ITX-TCODE = SY-TCODE )
AND ( ITX-PFKEY IS INITIAL OR ITX-PFKEY = SY-PFKEY )
AND ( ITX-TITLE IS INITIAL OR ITX-TITLE = SY-TITLE ).
MOVE-CORRESPONDING ITX TO ITVAR.
APPEND ITVAR.
ENDIF.
ENDSELECT.
SORT ITVAR.
DELETE ADJACENT DUPLICATES FROM ITVAR.
ENDFORM.
FORM SELECT_VARIANT.
ENDFORM.
FORM LIST_SELECT_VARIANT USING EVENT.
ENDFORM.
FORM CELLS_OPTIMIZATION.
DATA: BEGIN OF ITLM OCCURS 0,
CELLS TYPE I,
XLINE TYPE SLIST_LISTLINE-LINE,
COUNT TYPE I,
INDEX TYPE I,
END OF ITLM.
DATA: BEGIN OF ITLX OCCURS 0,
INDEX TYPE I,
END OF ITLX.
DATA: INDEX TYPE I.
DATA: TCOUNT TYPE I.
DATA: PROC TYPE I.
DATA: CH TYPE C.
DATA: XLINE TYPE SLIST_LISTLINE-LINE,
XLINE_LEN TYPE I.
DATA: DX TYPE Y96XL_TD.
DATA: TABIX LIKE SY-TABIX.
DATA: GTABIX LIKE SY-TABIX.
DATA: LTABIX LIKE SY-TABIX.
DATA: MODIFYED TYPE C.
CHECK SCR-CELLS_OPTIMIZATION = 'X'.
* 1 Группируем группы строк по рассечению
LOOP AT ITL.
CLEAR ITLM.
LOOP AT ITL-ITD INTO DM.
ADD 1 TO ITLM-CELLS.
ITLM-XLINE+DM-END(1) = 'X'.
ENDLOOP.
READ TABLE ITLM WITH KEY CELLS = ITLM-CELLS
XLINE = ITLM-XLINE
BINARY SEARCH.
IF SY-SUBRC = 0.
ADD ITL-COUNT TO ITLM-COUNT.
MODIFY ITLM INDEX SY-TABIX TRANSPORTING COUNT.
ELSE.
ADD 1 TO INDEX.
ITLM-INDEX = INDEX.
ITLM-COUNT = ITL-COUNT.
INSERT ITLM INDEX SY-TABIX.
ENDIF.
ITLX-INDEX = INDEX.
APPEND ITLX.
ADD ITL-COUNT TO TCOUNT.
ENDLOOP.
* 2 Находим супер-группу с наибольшим количеством строк и наибольшим
* количеством ячеек
SORT ITLM DESCENDING BY COUNT CELLS.
READ TABLE ITLM INDEX 1.
PROC = ( ITLM-COUNT * 100 ) / TCOUNT .
CHECK PROC >= 40.
* 3 Строим карту рассеченияю
LOOP AT ITLM.
XLINE+XLINE_LEN = ITLM-XLINE+XLINE_LEN.
XLINE_LEN = STRLEN( XLINE ).
ENDLOOP.
* 4 Обрабатываем группы строк
READ TABLE ITLM INDEX 1 TRANSPORTING INDEX.
LOOP AT ITLX WHERE INDEX <> ITLM-INDEX.
READ TABLE ITL INDEX SY-TABIX.
LTABIX = SY-TABIX.
CLEAR MODIFYED.
LOOP AT ITL-ITD INTO DM.
CHECK DM-XTYP IS INITIAL.
GTABIX = SY-TABIX.
TABIX = SY-TABIX + 1.
DO.
CH = XLINE+DM-END(1).
IF CH <> 'X'.
READ TABLE ITL-ITD INTO DX INDEX TABIX.
IF SY-SUBRC = 0
AND DX-VLINE <> 'X'
AND DM-SID = DX-SID
AND DX-XTYP IS INITIAL.
DM-END = DX-END.
DM-LEN = DM-END - DM-POS + 1.
DM-UNITED = 'X'.
MODIFY ITL-ITD FROM DM INDEX GTABIX.
DELETE ITL-ITD INDEX TABIX.
MODIFYED = 'X'.
ELSE.
EXIT.
ENDIF.
ELSE.
EXIT.
ENDIF.
ENDDO.
ENDLOOP.
CH = XLINE+DM-END(1).
IF CH <> 'X'
AND DM-XTYP IS INITIAL.
DO.
ADD 1 TO DM-END.
CH = XLINE+DM-END(1).
IF CH = 'X'
OR DM-END >= XLINE_LEN. " на всякий случай - такого быть не долж
EXIT.
ENDIF.
ENDDO.
DM-LEN = DM-END - DM-POS + 1.
MODIFY ITL-ITD FROM DM INDEX GTABIX.
MODIFYED = 'X'.
ENDIF.
IF MODIFYED = 'X'.
MODIFY ITL INDEX LTABIX TRANSPORTING ITD.
ENDIF.
ENDLOOP.
ENDFORM.
FORM FILE_DOWNLOAD TABLES DATA_TAB
USING FILENAME FILESIZE.
CALL FUNCTION 'WS_DOWNLOAD'
EXPORTING
BIN_FILESIZE = FILESIZE
FILENAME = FILENAME
FILETYPE = 'BIN'
TABLES
DATA_TAB = DATA_TAB
EXCEPTIONS
FILE_OPEN_ERROR = 1
FILE_WRITE_ERROR = 2
INVALID_FILESIZE = 3
INVALID_TABLE_WIDTH = 4
INVALID_TYPE = 5
NO_BATCH = 6
UNKNOWN_ERROR = 7
GUI_REFUSE_FILETRANSFER = 8
OTHERS = 9.
ENDFORM.
FORM WRITE_ABOUT.
WRITE:
/ 'This program has been developed by Kiyanov Dmitryi Evgenevich',
/ 'Site', 'http://www.dkiyanov.narod.ru' HOTSPOT,
/ 'Email dkiyanov@mail.ru',
/ 'It is a demonstration example showing to an opportunity of function',
/ 'group "Y96LIST_TO_EXCEL"',
/ 'This program is compilation of parts of an source code',
/ 'concerning to funcion group "Y96LIST_TO_EXCEL"'.
ENDFORM.