Liste aus einer internene Tabelle über FUBA erstellen

Code: Alles auswählen.

function z_list_table.
*"----------------------------------------------------------------------
*"*"Lokale Schnittstelle:
*"  IMPORTING
*"     VALUE(I_TABLE) TYPE  ANY TABLE
*"     VALUE(I_ZEBRA) TYPE  LVC_ZEBRA
*"     VALUE(I_ROWSEP) TYPE  ZROW_SEP
*"----------------------------------------------------------------------
  data:
    lv_intensiv type i.
  field-symbols:
    <ls_zeile> type any.
  format reset.
  loop at i_table[] assigning <ls_zeile>.
    at first.
      uline.
      perform write_headerline using <ls_zeile>.
      lv_intensiv = 1.
    endat.
    if i_zebra is initial.
      format color off intensified off.
    else.
      lv_intensiv = ( lv_intensiv + 1 ) mod 2.
      format color col_normal intensified = lv_intensiv.
    endif.
    perform write_line using <ls_zeile> i_rowsep.
    at last.
      if i_rowsep is initial.
        uline.
      endif.
    endat.
  endloop.
endfunction.

*&--------------------------------------------------------------------*
*&      Form  write_line
*&--------------------------------------------------------------------*
*       text
*---------------------------------------------------------------------*
*      -->VALUE(LP_LItext
*      -->VALUE(LP_ROtext)
*---------------------------------------------------------------------*
form write_line using value(lp_line) type any
                      value(lp_rowsep) type xfeld.
  data:
    lv_index type i,
    lr_edescr type ref to cl_abap_elemdescr,
    lr_cast type ref to cx_sy_move_cast_error,
    lv_string type string.
  field-symbols:
    <ls_field> type any,
    <ls_outlen> type i.
  lv_index = 1.
  assign component lv_index of structure lp_line to <ls_field>.
  while sy-subrc is initial.
    if lv_index = 1.
      write:
        / sy-vline no-gap.
    endif.
    try.
        lr_edescr ?= cl_abap_typedescr=>describe_by_data( <ls_field> ).
        case lr_edescr->type_kind.
          when cl_abap_elemdescr=>typekind_date.
            assign 10 to <ls_outlen>.
          when cl_abap_elemdescr=>typekind_string.
            assign 50 to <ls_outlen>.
          when others.
            assign lr_edescr->output_length to <ls_outlen>.
        endcase.
        write:
          at (<ls_outlen>) <ls_field> no-gap, sy-vline no-gap.
        add 1 to lv_index.
      catch cx_sy_move_cast_error into lr_cast.
        concatenate lr_cast->source_typename '->'
          lr_cast->target_typename
          into lv_string separated by space.
        perform fehler
          using 'WRITE_LINE' 'CX_SY_MOVE_CAST_ERROR' lv_string
                'X' sy-batch.
      catch cx_root. "all other
        perform fehler using 'WRITE_LINE' 'CX_ROOT' <ls_field>
                             'X' sy-batch.
      cleanup.
*     leave while loop
        lv_index = 9999999999.
    endtry.
    assign component lv_index of structure lp_line to <ls_field>.
  endwhile.
  write:
    at sy-linsz sy-vline.
  if not lp_rowsep is initial.
    uline.
  endif.
endform. "Write_line

*&--------------------------------------------------------------------*
*&      Form  fehler
*&--------------------------------------------------------------------*
*       text
*---------------------------------------------------------------------*
*      -->VALUE(LP_FOtext
*      -->VALUE(LP_VAtext
*      -->VALUE(LP_TEtext
*---------------------------------------------------------------------*
form fehler using value(lp_form) type csequence
                  value(lp_fehlerklasse) type csequence
                  value(lp_value) type any
                  value(lp_liste) type zchar1flag
                  value(lp_email) type zchar1flag.
* Diese Prozedur bzw. ihre Aufrufe kann später durch die zentrale
* Fehlerklasse ersetzt werden
  data:
    lv_wert type z_zeile.
  write lp_value to lv_wert.                                "#EC *
  shift lv_wert left deleting leading space.
  call function 'Z_ERRORMSG'
    exporting
      lp_part1 = lp_form
      lp_part2 = lp_fehlerklasse
      lp_part3 = lv_wert
      lp_zeile = '&1: Fehler &2 aufgetreten bei &3!'
      lp_liste = lp_liste
      lp_email = lp_email.
endform. "Fehler

*&--------------------------------------------------------------------*
*&      Form  write_headerline
*&--------------------------------------------------------------------*
*       text
*---------------------------------------------------------------------*
*      -->VALUE(LP_LItext
*---------------------------------------------------------------------*
form write_headerline using value(lp_line) type any.
  types:
    begin of lt_dd04t,
      reptext type dd04t-reptext,
      scrtext_s type dd04t-scrtext_s,
      scrtext_m type dd04t-scrtext_m,
      scrtext_l type dd04t-scrtext_l,
    end of lt_dd04t.
  data:
    lr_sdescr type ref to cl_abap_structdescr,
    lv_index type i,
    lv_reptext type reptext,
    lr_edescr type ref to cl_abap_elemdescr,
    lv_dd04t type lt_dd04t,
    lv_len type i,
    lr_cast type ref to cx_sy_move_cast_error,
    lv_string type string.
  field-symbols:
    <ls_field> type any,
    <ls_outlen> type i,
    <lr_compds> type abap_compdescr.
  format reset.
  format color col_heading intensified on.
  try.
      lr_sdescr ?= cl_abap_typedescr=>describe_by_data( lp_line ).
      lv_index = 1.
      assign component lv_index of structure lp_line to <ls_field>.
      while sy-subrc is initial.
        if lv_index = 1.
          uline.
          write:
            / sy-vline no-gap.
        endif.
        clear:
          lv_reptext.
        lr_edescr ?=  cl_abap_typedescr=>describe_by_data( <ls_field> ).
        assign lr_edescr->output_length to <ls_outlen>.
        case lr_edescr->type_kind.
          when cl_abap_typedescr=>typekind_date.
            assign 10 to <ls_outlen>.
          when cl_abap_typedescr=>typekind_string.
            assign 50 to <ls_outlen>.
          when others.
*           NOP
        endcase.
        if not lr_edescr->help_id is initial.
          select single reptext scrtext_s scrtext_m scrtext_l
            into corresponding fields of lv_dd04t
            from dd04t
            where rollname = lr_edescr->help_id
              and ddlanguage = sy-langu
              and as4local = 'A' "only activated
         and as4vers = '0000'. "not used is written at 2005-08-08 by SAP
          if not sy-subrc is initial.
*           NOP, not activated
          else.
            lv_len = strlen( lv_dd04t-reptext ).
            if lv_len > 0 and lv_len <= <ls_outlen>.
              lv_reptext = lv_dd04t-reptext.
            else.
              lv_len = strlen( lv_dd04t-scrtext_l ).
              if lv_len > 0 and lv_len <= <ls_outlen>.
                lv_reptext = lv_dd04t-scrtext_l.
              else.
                lv_len = strlen( lv_dd04t-scrtext_m ).
                if lv_len > 0 and lv_len <= <ls_outlen>.
                  lv_reptext = lv_dd04t-scrtext_m.
                else.
*                 no length check
                  lv_reptext = lv_dd04t-scrtext_s.
                endif.
              endif.
            endif.
          endif.
        endif.
        if lv_reptext is initial.
*         not activated or no DDIC type => we use the field name
          read table lr_sdescr->components[] index lv_index
            assigning <lr_compds>.
          if sy-subrc is initial.
            lv_reptext = <lr_compds>-name.
          else.
           perform fehler using 'WRITE_HEADERLINE' 'NOT_FOUND' lv_index
                                'X' sy-batch.
          endif.
        endif.
        write:
          at (<ls_outlen>) lv_reptext no-gap, sy-vline no-gap.
        add 1 to lv_index.
        assign component lv_index of structure lp_line to <ls_field>.
      endwhile.
      write:
        at sy-linsz sy-vline.
      uline.
    catch cx_sy_move_cast_error into lr_cast.
      concatenate lr_cast->source_typename '->'
        lr_cast->target_typename
        into lv_string separated by space.
      perform fehler
        using 'WRITE_HEADERLINE' 'CX_SY_MOVE_CAST_ERROR' lv_string
              'X' sy-batch.
    catch cx_root. "all other
      perform fehler using 'WRITE_HEADERLINE' 'CX_ROOT' <ls_field>
                           'X' sy-batch.
    cleanup.
*     NOP
  endtry.
endform. "Write_headerline