Поговорим об MS Script Control

[Gustav]

Чтобы не быть голословным, для примера приведу текст боевого метода (p.s. даже двух) на ABAP'е из своего класса выгрузки. Основное место занимает формирование текста модуля путем слияния (CONCATENATE) текстовых строк - операторов VBA:

  METHOD build_vbcode.
    "формирование полного текста VB-модуля для обслуживания конкретной внутр.таблицы

    DATA: flds_cnt_mns1  TYPE string,
          num2str        TYPE string.
    DATA: vbcode1        TYPE string,
          vbcode2        TYPE string,
          vbcode3        TYPE string,
          vbcode4        TYPE string,
          vbcode5        TYPE string,
          vbcode6        TYPE string,
          vbcode7        TYPE string,
          vbcode8        TYPE string,
          vbcode9        TYPE string.

    DATA  strtab         TYPE STANDARD TABLE OF string.

    flds_cnt_mns1 = me->flds_cnt - 1.

    CONCATENATE `Public f(` flds_cnt_mns1 `), headers(` flds_cnt_mns1 `)`
            INTO vbcode1.
    CONCATENATE `    For i = 0 To ` flds_cnt_mns1
            INTO vbcode2.

    CONCATENATE `    arr = Split(strParams, "` me->val_separator `")`
            INTO vbcode3.

    IF me->xl_sheetname IS NOT INITIAL.
      CONCATENATE `    wks.Name = "` me->xl_sheetname `"`
              INTO vbcode4.
    ENDIF.

    IF me->xl_visible = abap_true.
      vbcode5 = `    xlApp.Visible = True`.
    ENDIF.

    IF me->xl_sheetindex > 0.
      num2str = me->xl_sheetindex.
    ELSE.
      num2str = '0'.
    ENDIF.


    "KKU, 11.04.2012 -->
    "в процессе работ по тр. 1014 
    IF me->xl_shtrewrite = abap_false.

      CONCATENATE `    Call setSheetForOutput(` num2str `, False)` "выводим на абсолютно чистый лист
              INTO vbcode6.
    ELSE.

      CONCATENATE `    Call setSheetForOutput(` num2str `, True)` "выводим на любой лист (перезаписываем)
              INTO vbcode6.
    ENDIF.
    "<-- KKU, 11.04.2012

    IF me->xl_workbook IS INITIAL. "если рабочая книга создается заново
      CONCATENATE `    Set xlApp = CreateObject("Excel.Application")`
                   cl_abap_char_utilities=>cr_lf
                  `    Set wbk = xlApp.Workbooks.Add`
            INTO vbcode7.
    ELSE. "если выводим в ту же рабочую книгу, что и раньше
      vbcode7   = `    Set xlApp = wbk.Application`.
    ENDIF.


    IF me->rs_maxcolumns > 0 AND me->rs_maxcolumns < me->flds_cnt.
      "если кол-во выводимых колонок ограничено конкретным значением (считая слева от первой)
      num2str = me->rs_maxcolumns.
      CONCATENATE `        wks.Range("A2").CopyFromRecordset rst, ,` num2str
            INTO vbcode8.
      CONCATENATE `                               wks.Cells(1, ` num2str `))`
            INTO vbcode9.
    ELSE.
      "если кол-во выводимых колонок не указано
      vbcode8   = `        wks.Range("A2").CopyFromRecordset rst`.
      vbcode9   = `                               wks.Cells(1, UBound(headers) + 1))`.
    ENDIF.

    CALL METHOD me->build_recordset( ).

    CONCATENATE `Option Explicit`

                `Public rst`
                `Public wbk, wks, rngHeaders, rngITab`
                 vbcode1 "Public f( ... ), headers( ... )
                `Public captions`

                `Sub setCaptions(strCaptions, separator)`
                `    captions = Split(strCaptions, separator)`
                `End Sub`

                `Sub beforeLoop()`
                `    Dim i`
                `    Set rst = CreateObject("ADODB.Recordset")`
                 me->all_field_append "rst.Fields.Append
                `    rst.Open`
                 vbcode2 "For i = 0 To ...
                `        Set f(i) = rst.Fields(i)`
                `        headers(i) = f(i).Name`
                `        If IsArray(captions) Then` "прописывание заголовков, если есть; иначе - имена полей
                `            If i <= UBound(captions) Then`
                `                If captions(i) <> "" Then`
                `                    headers(i) = captions(i)`
                `                End If`
                `            End If`
                `        End If`
                `    Next`
                `End Sub`

                `Sub duringLoop(strParams)`
                `    Dim arr`
                 vbcode3 "arr = Split(strParams, "~~")`
                `    rst.AddNew`
                 me->all_field_setval "f(0).Value = ...
                `End Sub`

                `Sub afterLoop()`
                `    Dim xlApp`
                `    Dim cell`
                 vbcode7 "Set xlApp = CreateObject("Excel.Application") или Set xlApp = wbk.Application
                         "Set wbk = xlApp.Workbooks.Add
                 vbcode6 "Call setSheetForOutput( ... )
                `    If Not (rst.BOF And rst.EOF) Then`
                `        rst.Update`
                 vbcode8 "wks.Range("A2").CopyFromRecordset rst, ,...
                `        Call formatTimeColumns`
                `    End If`
                `    Set rngHeaders = wks.Range(wks.Cells(1, 1), _`
                 vbcode9 "wks.Cells(1, кол-во столбцов ))
                `    With rngHeaders`
                `        .Value = headers`
                `        .Font.Bold = True`
                `        If Not (rst.BOF And rst.EOF) Then`
                `            rst.MoveLast` "формально для правильного определения RecordCount
                `            Set rngITab = .Resize(rst.RecordCount + 1)` "CurrentRegion здесь не подходит из-за возможных пропусков
                `            rngITab.AutoFilter`
                `        Else`
                `            Set rngITab = rngHeaders` "если рекордсет пустой
                `        End If`
                `        .EntireColumn.AutoFit`
                `        .Borders.LineStyle = 1`
                `    End With`
                `    For Each cell In rngHeaders`
                `        If cell.ColumnWidth > 35 Then cell.ColumnWidth = 35`
                `    Next`
                `    wks.Cells(2, 1).Select`
                `    xlApp.ActiveWindow.FreezePanes = True`
                 vbcode4 "wks.Name = ...
                 vbcode5 "xlApp.Visible = ...
                `End Sub`

                `Sub setWorkbook(refToWorkbook)`
                `    Set wbk = refToWorkbook`
                `End Sub`

                `Function getWorkbook()` "выдает наружу ссылку на используемую рабочую книгу
                `    Set getWorkbook = wbk`
                `End Function`

                `Function getWorksheet()` "выдает наружу ссылку на используемый рабочий лист
                `    Set getWorksheet = wks`
                `End Function`

                `Function getITabRange()` "выдает наружу ссылку на диапазон выгруженной внутр.таблицы (заголовки+данные)
                `    Set getITabRange = rngITab`
                `End Function`

                `Sub setSheetForOutput(idx2add, rewrite)` "KKU, 11.12.2011, добавление параметра rewrite - перезаписывать лист
                `    Dim wkssCnt`
                `    Dim wkss`
                `    Set wkss = wbk.Worksheets`
                `    wkssCnt = wkss.Count`
                `    If idx2add = 0 Then`
                `        For Each wks In wkss`
                `            If wks.UsedRange.Address(False, False) = "A1" And IsEmpty(wks.Range("A1").Value) And idx2add = 0 Then`
                                 "если лист пустой и это первый пустой лист, то его и запоминаем
                `                idx2add = wks.Index`
                `            End If`
                `        Next`
                `    End If`
                `    If idx2add = 0 Then`
                         "если после перебора коллекции свободного листа всё еще не нашлось, добавляем последний (новый)
                `        idx2add = wkssCnt + 1`
                `    End If`
                `    If idx2add > wkssCnt Then`
                `        Set wks = wkss.Add(, wkss(wkssCnt), idx2add - wkssCnt)` "и лист становится активным (самый последний, если несколько)
                `    Else`
                         "проверяем, можно ли выводить на этот лист? т.е. пустой ли он?
                `        Set wks = wkss.Item(idx2add)` "здесь лист НЕ становится активным
                `        wks.Activate` "поэтому активируем его принудительно! иначе - КОВАРНАЯ ТРУДНОУЛОВИМАЯ ОШИБКА
                                           "эта активация нужна для избежания ошибки при выполнении xlApp.ActiveWindow.FreezePanes
                `        If Not rewrite Then` "KKU, 11.12.2011, если нельзя перезаписывать - деликатное вмешательство
                `            If Not (wks.UsedRange.Address(False, False) = "A1" And IsEmpty(wks.Range("A1").Value)) Then`
                                 "если лист не пустой - вставляем перед ним новый - before
                `                Set wks = wkss.Add(wks)` "и вставленный лист становится активным
                `            End If`
                `        End If`
                `    End If`
                `End Sub`

                `Sub activateFirstSheet()`
                `    wbk.Worksheets(1).Activate`
                `    wbk.Worksheets(1).Range("A1").Select`
                `End Sub`

                `Sub formatTimeColumns()`
                `    Dim rng, fld`
                `    Dim arr()`
                `    Dim i, cnt`
                `    For i = 0 To rst.Fields.Count - 1`
                `        Set fld = rst.Fields.Item(i)`
                `        If fld.Type = 7 Then` "а дата у нас - 133
                `            ReDim Preserve arr(cnt)`
                `            arr(cnt) = i + 1`
                `            cnt = cnt + 1`
                `        End If`
                `    Next`
                `    If cnt > 0 Then` "если колонки времени есть в принципе
                `        For i = LBound(arr) To UBound(arr)`
                `            If i = 0 Then`
                `                Set rng = wks.UsedRange.Columns(arr(i))`
                `            Else`
                `                Set rng = wks.Application.Union(rng, wks.UsedRange.Columns(arr(i)))`
                `            End If`
                `        Next`
                `        rng.NumberFormat = "hh:mm:ss"`
                `    End If`
                `End Sub`

            INTO me->vbcode
            SEPARATED BY cl_abap_char_utilities=>cr_lf.

  ENDMETHOD.                    "build_vbcode


  METHOD build_recordset.
    "формирует часть VB-кода, ответственного за создание и "обслуживание" recordset'а

    DATA wa_comp          TYPE abap_compdescr.
    DATA adofldtyp        TYPE string.
    DATA one_field_append TYPE string.
    DATA one_field_setval TYPE string.
    DATA idx              TYPE string.
    DATA temp             TYPE string.

    LOOP AT me->compdescr_tab INTO wa_comp.

      idx = sy-tabix - 1.

      adofldtyp = me->ado_field_type_by_type( inttype   = wa_comp-type_kind
                                              leng      = wa_comp-length
                                              decimals  = wa_comp-decimals ).

      "подготовка VB-операторов добавление полей
      CONCATENATE `    rst.Fields.Append "` wa_comp-name `",` adofldtyp
             INTO one_field_append.

      CONCATENATE me->all_field_append one_field_append
             INTO me->all_field_append
             SEPARATED BY cl_abap_char_utilities=>cr_lf.

      "подготовка VB-операторов для установки значений
      CASE adofldtyp.
        WHEN ' 133'. "дата
          CONCATENATE `    If arr(` idx `) <> "" And arr(` idx `) <> "00000000" Then`
                 INTO temp.
          CONCATENATE `        f(` idx `).Value = DateSerial(Left(arr(` idx `), 4), Mid(arr(` idx `), 5, 2), Right(arr(` idx `), 2))`
                 INTO one_field_setval.
          CONCATENATE temp one_field_setval `    End If`
                 INTO one_field_setval
                 SEPARATED BY cl_abap_char_utilities=>cr_lf.

        WHEN ' 7'. "время (как дата) - более подходящего типа не нашлось
          CONCATENATE `    If arr(` idx `) <> "" Then`
                 INTO temp.
          CONCATENATE `        f(` idx `).Value = TimeSerial(Left(arr(` idx `), 2), Mid(arr(` idx `), 3, 2), Right(arr(` idx `), 2))`
                 INTO one_field_setval.
          CONCATENATE temp one_field_setval `    End If`
                 INTO one_field_setval
                 SEPARATED BY cl_abap_char_utilities=>cr_lf.

        WHEN ' 3'. "целые
          CONCATENATE `    f(` idx `).Value = CLng(arr(` idx `))`
                 INTO one_field_setval.

        WHEN ' 5'. "веществ.
          CONCATENATE `    f(` idx `).Value = CDbl(arr(` idx `))`
                 INTO one_field_setval.

        WHEN ' 6'. "денежные
          CONCATENATE `    f(` idx `).Value = CCur(arr(` idx `))`
                 INTO one_field_setval.

        WHEN OTHERS. "строки
          CONCATENATE `    f(` idx `).Value = arr(` idx `)`
                 INTO one_field_setval.
      ENDCASE.

      CONCATENATE me->all_field_setval one_field_setval
             INTO me->all_field_setval
             SEPARATED BY cl_abap_char_utilities=>cr_lf.

    ENDLOOP.
    "последние символы общей строки можно не удалять - они не мешают строкам VB-модуля

  ENDMETHOD.                    "build_recordset

Отладка такого кода, конечно, не подарок. Но если потихоньку, пофрагментно в нормальном VB(VBA), то вполне одолимо. Результат того стоит.