FUNCTION-POOL Y96_LIST_TO_EXCEL 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
TYPE-POOLS: SLIST, SYDES, Y96XL.
DATA: KDE_PURCHASE TYPE C VALUE '-'.
INCLUDE .
INCLUDE .
INCLUDE .
INCLUDE OLE2INCL.
INCLUDE Y96LIST.
INCLUDE Y96KDE_ABOUT.
INCLUDE LY96_LIST_TO_EXCELF00.
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.
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 SY-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.
DATA: WIDTH TYPE I,
HEIGHT TYPE I.
DATA: TABIX LIKE SY-TABIX.
CHECK SCR-ROWFILTER_ON = 'X'.
WIDTH = LIST_WIDTH + 19.
IF WIDTH < 25. WIDTH = 27. ENDIF.
IF WIDTH > 250. WIDTH = 250. ENDIF.
DESCRIBE TABLE ITL.
HEIGHT = SY-TFILL + 4.
IF HEIGHT > 20. HEIGHT = 20. ENDIF.
CALL FUNCTION 'Y96_LIST'
EXPORTING
CALLBACK_FORM = 'LIST_ROW_FILTER'
COL = 5
ROW = 5
WIDTH = WIDTH
HEIGHT = HEIGHT
EXCEPTIONS
CANCEL = 1
OTHERS = 2.
IF SY-SUBRC <> 0.
BREAK = 'X'.
EXIT.
ENDIF.
LOOP AT ITL WHERE UNIFY = 'X'.
TABIX = SY-TABIX.
DESCRIBE TABLE ITL-ITD.
CLEAR DM.
READ TABLE ITL-ITD INTO DM INDEX SY-TFILL TRANSPORTING END.
DM-LEN = DM-END - DM-POS + 1.
DM-SID = '0OO'.
DM-UNITED = 'X'.
REFRESH ITL-ITD.
APPEND DM TO ITL-ITD.
MODIFY ITL INDEX TABIX TRANSPORTING ITD.
ENDLOOP.
ENDFORM.
FORM LIST_ROW_FILTER USING EVENT.
DATA: LIST_WA TYPE SLIST_LISTLINE.
DATA: DM_LEN TYPE I.
DATA: WIDTH TYPE I.
FIELD-SYMBOLS .
CASE EVENT.
WHEN EV_LIST.
SET PF-STATUS 'LINE_FILTER'.
SET TITLEBAR 'LINE_FILTER'.
WIDTH = LIST_WIDTH + 19.
NEW-PAGE LINE-SIZE WIDTH.
LOOP AT ITL.
FORMAT COLOR COL_KEY.
WRITE: / SY-VLINE, ITL-UNIFY AS CHECKBOX,
SY-VLINE, ITL-EXLUD AS CHECKBOX,
SY-VLINE, (5) ITL-COUNT NO-GAP,
SY-VLINE.
FORMAT COLOR OFF.
HIDE SY-TABIX.
READ TABLE XLIST INTO LIST_WA INDEX ITL-FIRST.
LOOP AT ITL-ITD INTO DM.
DM_LEN = DM-END - DM-BGN + 1.
ASSIGN LIST_WA-LINE+DM-BGN(DM_LEN) TO .
TRANSLATE DM-SID USING 'O0X1'.
WRITE: COLOR = DM-SID-COLOR
INTENSIFIED = DM-SID-INTENSE
INVERSE = DM-SID-INVERSE
NO-GAP.
ENDLOOP.
WRITE AT SY-LINSZ SY-VLINE.
ENDLOOP.
WRITE: / SY-VLINE, SPACE,
SY-VLINE, SPACE,
SY-VLINE, (5) SPACE NO-GAP,
SY-VLINE,
AT SY-LINSZ SY-VLINE.
ULINE.
WHEN EV_TOP OR EV_TOPD.
WRITE: TEXT-001.
ULINE.
FORMAT COLOR COL_HEADING.
WRITE: / SY-VLINE, ICON_MODIFY AS ICON NO-GAP,
SY-VLINE, ICON_DELETE AS ICON NO-GAP,
SY-VLINE, (5) TEXT-002 NO-GAP,
SY-VLINE, TEXT-003,
AT SY-LINSZ SY-VLINE.
FORMAT COLOR OFF.
ULINE.
WRITE: / SY-VLINE, SPACE,
SY-VLINE, SPACE,
SY-VLINE, (5) SPACE NO-GAP,
SY-VLINE,
AT SY-LINSZ SY-VLINE.
WHEN EV_OKAY.
DO.
CLEAR ITL-EXLUD.
READ LINE SY-INDEX FIELD VALUE ITL-UNIFY ITL-EXLUD.
IF SY-SUBRC <> 0. EXIT. ENDIF.
CHECK ITL-EXLUD = 'X' OR ITL-UNIFY = 'X'.
IF ITL-EXLUD = 'X' AND ITL-UNIFY = 'X'.
MESSAGE E015.
ENDIF.
MODIFY ITL INDEX SY-TABIX TRANSPORTING UNIFY EXLUD.
ENDDO.
WHEN 'SELA' OR 'SELD'.
DO.
READ LINE SY-INDEX.
IF SY-SUBRC <> 0. EXIT. ENDIF.
IF EVENT = 'SELA'.
ITL-EXLUD = 'X'.
ELSE.
ITL-EXLUD = ' '.
ENDIF.
MODIFY LINE SY-INDEX FIELD VALUE ITL-EXLUD.
ENDDO.
ENDCASE.
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.
DATA: LTAB(256) TYPE X.
FIELD-SYMBOLS: , .
XASSIGN LIST[] .
XASSIGN XLIST[] .
LTAB = .
= .
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.
= LTAB.
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.
CALL METHOD OF H_WORK 'SAVE'.
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.
DATA: LEXT TYPE I.
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.
LEXT = STRLEN( EXT ).
IF LEXT > 4.
CONCATENATE FILENAME XLSEXT INTO FILENAME.
ENDIF.
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.
ELSEIF DPOS = 0.
CONCATENATE PROGRAM_DIR FILENAME INTO FILENAME.
PERFORM CHECK_FILE_EXIST USING FILENAME.
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.
DATA: NOT_CALL_SCREEN TYPE C.
DATA: CANCEL TYPE C.
PERFORM ON_CONFIRM TABLES ITVAR
USING SELECT_VAR
SCR
NOT_CALL_SCREEN
CANCEL.
IF CANCEL = 'X'.
SY-SUBRC = 4.
EXIT.
ENDIF.
IF NOT_CALL_SCREEN <> 'X'.
PERFORM GET_VARIANTS.
EVENT = XEVENT.
CALL SCREEN 100 STARTING AT 10 10.
ENDIF.
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.
MODULE STATUS_0100 OUTPUT.
REFRESH ITEXUCOMM.
PERFORM KDE_CHECK_RGD USING RGD.
IF RGD = 'X'.
APPEND 'ABUT' TO ITEXUCOMM.
ENDIF.
PERFORM ON_CONFIRM_PBO TABLES ITEXUCOMM
USING SCR.
IF ITVAR[] IS INITIAL.
APPEND 'VARI' TO ITEXUCOMM.
ENDIF.
SET PF-STATUS 'XLSPM' EXCLUDING ITEXUCOMM.
SET TITLEBAR 'XLSPM'.
IF SCR-ADV <> 'X'.
LOOP AT SCREEN.
CHECK SCREEN-GROUP1 = 'ADV'.
SCREEN-ACTIVE = 0.
MODIFY SCREEN.
ENDLOOP.
ENDIF.
IF SELECT_VAR-TEXT IS INITIAL.
LOOP AT SCREEN.
CHECK SCREEN-GROUP1 = 'VAR'.
SCREEN-ACTIVE = 0.
MODIFY SCREEN.
ENDLOOP.
ENDIF.
ENDMODULE. " STATUS_0100 OUTPUT
MODULE USER_COMMAND_0100 INPUT.
CASE SY-UCOMM.
WHEN 'OKAY'.
CLEAR SY-SUBRC.
LEAVE TO SCREEN 0.
WHEN 'XADV'.
TRANSLATE SCR-ADV USING ' XX '.
WHEN 'VARI'.
PERFORM SELECT_VARIANT.
WHEN 'ABUT'.
PERFORM KDE_ABOUT USING SPACE.
WHEN 'INFO'.
PERFORM SHOW_INFO.
ENDCASE.
ENDMODULE. " USER_COMMAND_0100 INPUT
FORM CHECK_FILE_EXIST USING FILENAME.
DATA: RETURN TYPE C.
DATA: TEXTLINE1(132) TYPE C.
CHECK FILENAME CA '\'.
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
MODULE F4_SCR_FNAME INPUT.
CALL FUNCTION 'WS_FILENAME_GET'
EXPORTING
* def_filename = '.xls'
* def_path = 'c:\'
MASK = ',*.*,*.xls.'
MODE = 'S'
TITLE = 'Введите имя файла'
IMPORTING
FILENAME = SCR-FNAME
EXCEPTIONS
INV_WINSYS = 1
NO_BATCH = 2
SELECTION_CANCEL = 3
SELECTION_ERROR = 4
OTHERS = 5.
PERFORM CHECK_FILE_EXT USING SCR-FNAME.
ENDMODULE. " F4_XLSFNAME INPUT
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.
MODULE CHECK_FILE INPUT.
IF NOT SCR-FNAME IS INITIAL.
PERFORM CHECK_FILE USING SCR-FNAME.
ENDIF.
ENDMODULE. " CHECK_FILE INPUT
MODULE CHECK_EXEC INPUT.
IF SCR-FNAME IS INITIAL AND SCR-EXEC <> 'X'.
MESSAGE E007.
ENDIF.
ENDMODULE. " CHECK_EXEC INPUT
MODULE F4_SCR_CHECKBOX INPUT.
PERFORM F4_SCR_XMODE USING SCR-CHECKBOX_MODE.
ENDMODULE. " F4_XLSCHECKBOX INPUT
MODULE F4_SCR_ICON INPUT.
PERFORM F4_SCR_XMODE USING SCR-ICON_MODE.
ENDMODULE. " F4_XLSICON INPUT
MODULE F4_SCR_SYMBOL INPUT.
PERFORM F4_SCR_XMODE USING SCR-SYMBOL_MODE.
ENDMODULE. " F4_XLSSYMBOL INPUT
FORM F4_SCR_XMODE USING MODE.
DATA: REPID LIKE SY-REPID.
REPID = SY-REPID.
CALL FUNCTION 'Y96_LIST'
EXPORTING
CALLBACK_PROGRAM = REPID
CALLBACK_FORM = 'LIST_F4_XLSXMODE'
COL = 5
ROW = 5
WIDTH = 25
HEIGHT = 5
EXCEPTIONS
CANCEL = 1
OTHERS = 2.
CHECK SY-SUBRC = 0.
MODE = XLS_X_MODE.
ENDFORM.
FORM LIST_F4_XLSXMODE USING EVENT.
CASE EVENT.
WHEN EV_LIST.
SET PF-STATUS 'DIALOG'.
WRITE: / SY-VLINE, '-' COLOR COL_KEY,
SY-VLINE, (18) TEXT-004, SY-VLINE.
WRITE: / SY-VLINE, 'T' COLOR COL_KEY,
SY-VLINE, (18) TEXT-005, SY-VLINE.
WRITE: / SY-VLINE, 'X' COLOR COL_KEY,
SY-VLINE, (18) TEXT-006, SY-VLINE.
ULINE.
WHEN EV_TOP.
ULINE.
FORMAT COLOR COL_HEADING.
WRITE: / SY-VLINE, 'X',
SY-VLINE, (18) TEXT-007, SY-VLINE.
FORMAT COLOR OFF.
ULINE.
WHEN EV_LINE.
READ CURRENT LINE.
XLS_X_MODE = SY-LISEL+2(1).
CHECK XLS_X_MODE CO '-TX'.
EVENT = EV_OKAY.
ENDCASE.
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.
DATA: HEIGHT TYPE I.
DESCRIBE TABLE ITVAR LINES HEIGHT.
ADD 4 TO HEIGHT.
IF HEIGHT > 17. HEIGHT = 17. ENDIF.
CALL FUNCTION 'Y96_LIST'
EXPORTING
CALLBACK_FORM = 'LIST_SELECT_VARIANT'
COL = 15
ROW = 15
WIDTH = 42
HEIGHT = HEIGHT
EXCEPTIONS
CANCEL = 1
OTHERS = 2.
IF SY-SUBRC <> 0.
EVENT = XEVENT.
CLEAR SELECT_VAR.
ELSE.
EVENT = XEVENT.
SELECT_VAR = ITVAR.
PERFORM CALL_ON_VARIANT.
ENDIF.
ENDFORM.
FORM LIST_SELECT_VARIANT USING EVENT.
CASE EVENT.
WHEN EV_LIST.
SET PF-STATUS 'DIALOG'.
SET TITLEBAR 'VARIANTS'.
LOOP AT ITVAR.
WRITE: / ITVAR-TEXT COLOR COL_KEY.
HIDE SY-TABIX.
ENDLOOP.
WHEN EV_LINE.
CLEAR SY-TABIX.
READ CURRENT LINE.
CHECK NOT SY-TABIX IS INITIAL.
READ TABLE ITVAR INDEX SY-TABIX.
CHECK SY-SUBRC = 0.
EVENT = EV_OKAY.
ENDCASE.
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 SHOW_INFO.
CALL FUNCTION 'Y96_LIST'
EXPORTING
CALLBACK_FORM = 'LIST_INFO'
COL = 10
ROW = 19
WIDTH = 72
HEIGHT = 14
EXCEPTIONS
CANCEL = 1
OTHERS = 2.
ENDFORM.
FORM LIST_INFO USING EVENT.
CASE EVENT.
WHEN EV_LIST.
SET PF-STATUS SPACE.
NEW-PAGE LINE-SIZE 71.
CASE SY-LANGU.
WHEN OTHERS. " 'R'. " Russian
WRITE:
/ 'Описание параметров:' COLOR COL_HEADING,
/ 'Имя файла:' COLOR COL_KEY,
'имя файла можно не указывать в этом случае система',
/ ' создаст файл с именем Y96LTEBHTMP1.XLS - Y96LTEBHTMP15.XLS',
/ ' в рабочем каталоге GUI, если имя файла указано без пути',
/ ' файл будет создан в рабочем каталоге GUI, если имя файла',
/ ' указано без расширения файл будет создан с расширением ".XLS",',
/ ' если имя файла указано с расширением отличным от ".XLS"',
/ ' файл будет создан в формате "HTML" и если стоит галка "Открыть',
/ ' файл" - файл будет открыт программой в соответствии с указаным',
/ ' расширением например для того что-бы загрузить листинг в',
/ ' Microsoft Word напишите ".doc", Internet Explorer - ".htm"',
/ ' или расширение какой либо другой программы понимающей',
'формат "HTML"',
/ 'Открыть файл:' COLOR COL_KEY,
'если выбрано - файл будет открыт программой в',
/ ' соответствии с указаным расширением см. Имя файла.',
/ 'Не показывать границы столцов:' COLOR COL_KEY,
'если выбрано - в Excel-е границы',
/ ' ячеек не будут выделены.',
/ 'Не показыв цвета:' COLOR COL_KEY,
'если выбрано - в Excel-е все ячейки будут иметь',
/ ' стандартный для Excel-я цвет фона и цвет шрифта.',
/ '.',
/ 'Дополнительные параметры:' COLOR COL_HEADING,
'появляются после нажатия кнопки', ICON_NET_GRAPHIC AS ICON,
/ 'Оптимизация ячеек:' COLOR COL_KEY,
'если выбрано - будет произведена ',
/ ' оптимизация ячеек с целю уменьшения количества объединений ',
/ ' ячеек - в результате может произойти слияние части ячеек и или ',
/ ' изменение размеров ячеек',
/ 'Вывести строковый фильтр:' COLOR COL_KEY,
'если выбрано - после нажатия кнопки', ICON_OKAY AS ICON,
/ ' появится окно строкового фильтра',
/ 'Не объеденять ячейки:' COLOR COL_KEY,
'если выбрано - в Excel-е объединение ячеек',
/ ' производиться не будет.',
/ 'Примечание:' COLOR COL_TOTAL,
/ ' Было обнаружено что большое число объединений ячеек приводит к',
/ ' силному увеличению времени загруки Excel файла (как первичной',
/ ' так и последующих загрузок) по-этому при выгрузке больших',
/ ' листингов желательно уменьшить или исключить объединение ячеек',
/ ' это можно сделать с помощью см. выше пункты:',
'"Оптимизация ячеек"' COLOR COL_TOTAL, ',',
/ ' ', '"Вывести строковый фильтр"' COLOR COL_TOTAL, ',',
'"Не объеденять ячейки"' COLOR COL_TOTAL, '.',
/ 'CheckBox-ы:' COLOR COL_KEY,
'поле ввода для галочки (см. ниже "Режимы") например -',
/ ' режим "X" -', ' ' AS CHECKBOX, 'соотв. в режиме "T" - " "',
/ ' режим "X" -', 'X' AS CHECKBOX, 'соотв. в режиме "T" - "X"',
/ 'Иконки:' COLOR COL_KEY,
'маленькие картинки (см. ниже "Режимы") например -',
/ ' режим "X" -', ICON_FAILURE AS ICON, ICON_POSITIVE AS ICON,
/ ' в режиме "X" перед сзданием файла иконки сохраняются в',
/ ' под католог SAP_ICONS в рабочем каталоге GUI в файлы с',
/ ' форматом "GIF",',
/ ' в режиме "T" каждай иконке соответствует уникальное двух',
/ ' буквенное сочетание',
/ 'SAP_символы:' COLOR COL_KEY,
/ ' символы из шрифта "SAP Dings" (см. ниже "Режимы") например -',
/ ' режим "X" -', SYM_PHONE AS SYMBOL, SYM_PRINTER AS SYMBOL,
/ ' в режиме "T" каждому символу соответствует символ из обычного',
/ ' шрифта в нашем случае это шрифт "Courier New"',
/ 'Режимы -' COLOR COL_KEY,
'возможные значения для параметров:',
/ ' CheckBox-ы, Иконки, SAP_символы' COLOR COL_TOTAL, 'см. выше',
/ ' значение "-" - выводится соотв. число пробелов,',
/ ' значение "T" - текстовый эквивалент соотв. объекта',
/ ' значение "X" - нормальное представление соотв. объекта'.
ENDCASE.
ENDCASE.
ENDFORM.