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 '
'. PERFORM ADD_TEXT USING '
Используются технологии uCoz
'. 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.
Используются технологии uCoz