este es el codigo del prog. En rojo pongo donde me da el error.
Gracias
*----------------------------------------------------------------------*
* INCLUDE Z_DISPLAY_TABLE
*----------------------------------------------------------------------*
* Display ANY table by reference
* Table must be defined with TYPE statement (object oriented)
*
* HOW TO USE
* - include this program into your program (data definition part)
* - CALL METHOD lcl_table_display=>display_list or display_grid
* EXPORTING data = yourinternaltable
*
*----------------------------------------------------------------------*
* Author: François Henrotte (EPONA Solutions)
* Site:
*----------------------------------------------------------------------*
*----------------------------------------------------------------------*
* LCL_TABLE_DISPLAY DEFINITION
*----------------------------------------------------------------------*
CLASS lcl_table_display DEFINITION.
PUBLIC SECTION.
TYPE-POOLS: abap, slis.
CLASS-METHODS: display_list IMPORTING in_data TYPE STANDARD TABLE,
display_grid IMPORTING in_data TYPE STANDARD TABLE.
METHODS: constructor IMPORTING in_data TYPE STANDARD TABLE
EXCEPTIONS casting_error
empty_fieldcat.
METHODS: output_list,
output_grid.
METHODS: set_table_name IMPORTING in_tabname TYPE any,
set_alv_title IMPORTING in_title TYPE any,
set_alv_settings IMPORTING in_settings TYPE any,
set_alv_layout IMPORTING in_layout TYPE any,
set_alv_event IMPORTING in_name TYPE any
in_form TYPE any.
PRIVATE SECTION.
CLASS-DATA: g_table_object TYPE REF TO lcl_table_display.
TYPES: BEGIN OF ty_defin,
fieldname TYPE fieldname,
ref_tabname TYPE tabname,
ref_fieldname TYPE fieldname,
END OF ty_defin.
DATA: g_repid TYPE repid,
g_struc TYPE tabname,
g_table TYPE tabname.
DATA: gt_data TYPE REF TO data.
DATA: g_title TYPE lvc_title,
gt_fcat TYPE slis_t_fieldcat_alv,
gs_sett TYPE lvc_s_glay,
gs_layo TYPE slis_layout_alv,
gt_evnt TYPE slis_t_event.
DATA: gt_defin TYPE TABLE OF ty_defin,
g_level TYPE tabname.
METHODS: output_table IMPORTING data TYPE REF TO data
mode TYPE c,
fill_fieldcat IMPORTING repid TYPE repid
struc TYPE tabname
CHANGING fcat TYPE slis_t_fieldcat_alv
EXCEPTIONS no_definition,
get_definition IMPORTING repid TYPE repid
struc TYPE tabname
CHANGING abap TYPE rsfb_source,
recursive_definition IMPORTING repid TYPE repid
CHANGING abap TYPE rsfb_source,
map_structure IMPORTING source TYPE any
CHANGING destin TYPE any.
ENDCLASS.
*----------------------------------------------------------------------*
* LCL_TABLE_DISPLAY IMPLEMENTATION
*----------------------------------------------------------------------*
CLASS lcl_table_display IMPLEMENTATION.
***
* Display table in ALV list
***
METHOD display_list.
IF NOT g_table_object IS INITIAL.
FREE: g_table_object.
ENDIF.
CREATE OBJECT g_table_object EXPORTING in_data = in_data.
CALL METHOD g_table_object->output_list.
ENDMETHOD.
***
* Display table in ALV grid
***
METHOD display_grid.
IF NOT g_table_object IS INITIAL.
FREE: g_table_object.
ENDIF.
CREATE OBJECT g_table_object EXPORTING in_data = in_data.
CALL METHOD g_table_object->output_grid.
ENDMETHOD.
***
* Create table display
***
METHOD constructor.
DATA: ls_data TYPE REF TO data.
DATA: ob_desc TYPE REF TO cl_abap_structdescr.
DATA: l_absol TYPE char200,
l_repid TYPE repid,
l_struc TYPE tabname.
FIELD-SYMBOLS: <table> TYPE STANDARD TABLE,
<struc> TYPE ANY.
* Get data and store it into attribute
CREATE DATA me->gt_data LIKE in_data.
ASSIGN me->gt_data->* TO <table>.
<table> = in_data.
* Get global data definition
CREATE DATA ls_data LIKE LINE OF <table>.
ASSIGN ls_data->* TO <struc>.
CATCH SYSTEM-EXCEPTIONS assign_casting_illegal_cast = 1.
ob_desc ?= cl_abap_typedescr=>describe_by_data( <struc> ).
ENDCATCH.
IF sy-subrc = 1.
RAISE casting_error.
ENDIF.
* Get program name and main type used to define table
l_absol = ob_desc->absolute_name.
SPLIT l_absol AT '\TYPE=' INTO l_repid l_struc.
SHIFT l_repid UP TO '='.
SHIFT l_repid.
CHECK l_struc NP '%_*'.
IF me->g_repid NE l_repid
OR me->g_struc NE l_struc.
* Set attributes
me->g_repid = l_repid.
me->g_struc = l_struc.
me->g_table = l_struc.
REPLACE 'TY' WITH 'WT' INTO me->g_table.
* Field catalog
CALL METHOD fill_fieldcat EXPORTING repid = l_repid
struc = l_struc
CHANGING fcat = me->gt_fcat.
IF me->gt_fcat IS INITIAL.
RAISE empty_fieldcat.
ENDIF.
ENDIF.
ENDMETHOD.
***
* Output list
***
METHOD output_list.
CALL METHOD output_table EXPORTING data = me->gt_data
mode = 'L'.
ENDMETHOD.
***
* Output grid
***
METHOD output_grid.
CALL METHOD output_table EXPORTING data = me->gt_data
mode = 'G'.
ENDMETHOD.
***
* Output table
***
METHOD output_table.
DATA: ls_vari TYPE disvariant.
FIELD-SYMBOLS: <table> TYPE STANDARD TABLE.
ASSIGN me->gt_data->* TO <table>.
* Get default user variant
ls_vari-report = me->g_repid.
ls_vari-username = sy-uname.
CALL FUNCTION 'REUSE_ALV_VARIANT_DEFAULT_GET'
EXPORTING
i_save = 'U'
CHANGING
cs_variant = ls_vari
EXCEPTIONS
OTHERS = 0.
* Display table contents
IF mode = 'G'.
CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
EXPORTING
i_callback_program = me->g_repid
i_grid_title = me->g_title
i_grid_settings = me->gs_sett
is_layout = me->gs_layo
it_fieldcat = me->gt_fcat
i_save = 'U'
is_variant = ls_vari
it_events = me->gt_evnt
TABLES
t_outtab = <table>
EXCEPTIONS
OTHERS = 0.
ELSE.
CALL FUNCTION 'REUSE_ALV_LIST_DISPLAY'
EXPORTING
i_callback_program = me->g_repid
is_layout = me->gs_layo
it_fieldcat = me->gt_fcat
i_save = 'U'
is_variant = ls_vari
it_events = me->gt_evnt
TABLES
t_outtab = <table>
EXCEPTIONS
OTHERS = 0.
ENDIF.
ENDMETHOD.
***
* Fill field catalog
***
METHOD fill_fieldcat.
DATA: lt_abap TYPE TABLE OF rssource.
DATA: ls_defin TYPE ty_defin.
DATA: lt_dfies TYPE TABLE OF dfies,
ls_dfies TYPE dfies,
ls_dd04v TYPE dd04v,
ls_dd01v TYPE dd01v,
l_flong TYPE dfies-lfieldname,
l_dname TYPE dfies-domname.
DATA: ls_fcat TYPE slis_fieldcat_alv,
ls_fcat2 TYPE slis_fieldcat_alv.
DATA: l_index TYPE i,
l_nbfld TYPE i.
FREE: me->gt_defin.
* Process data definition
CALL METHOD get_definition EXPORTING repid = repid
struc = struc
CHANGING abap = lt_abap.
* Process sub levels if required
CALL METHOD recursive_definition EXPORTING repid = repid
CHANGING abap = lt_abap.
IF me->gt_defin IS INITIAL.
RAISE no_definition.
ENDIF.
LOOP AT me->gt_defin INTO ls_defin.
CLEAR: ls_fcat.
MOVE-CORRESPONDING ls_defin TO ls_fcat.
* Retrieve info about this field
FREE: ls_dfies, ls_dd04v, ls_dd01v, l_dname.
l_flong = ls_fcat-ref_fieldname.
SET LOCALE LANGUAGE 'E'.
TRANSLATE: ls_fcat-ref_tabname TO UPPER CASE,
ls_fcat-ref_fieldname TO UPPER CASE,
l_flong TO UPPER CASE.
IF NOT ls_fcat-ref_tabname IS INITIAL.
* Try to get info about field in table
CALL FUNCTION 'DDIF_FIELDINFO_GET'
EXPORTING
tabname = ls_fcat-ref_tabname
fieldname = ls_fcat-ref_fieldname
lfieldname = l_flong
IMPORTING
dfies_wa = ls_dfies
EXCEPTIONS
not_found = 1
internal_error = 2
OTHERS = 3.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dfies TO ls_fcat.
ls_fcat-fieldname = ls_defin-fieldname.
MOVE: ls_dfies-keyflag TO ls_fcat-key,
ls_dfies-scrtext_m TO ls_fcat-seltext_l,
ls_dfies-domname TO l_dname.
ENDIF.
ELSE.
* Try to get info about structure
ls_defin-ref_tabname = ls_defin-ref_fieldname.
CALL FUNCTION 'DDIF_FIELDINFO_GET'
EXPORTING
tabname = ls_defin-ref_tabname
TABLES
dfies_tab = lt_dfies
EXCEPTIONS
OTHERS = 0.
IF NOT lt_dfies IS INITIAL.
* Process fields of this structure
LOOP AT lt_dfies INTO ls_dfies.
CLEAR: ls_fcat.
MOVE-CORRESPONDING ls_dfies TO ls_fcat.
CONCATENATE ls_defin-fieldname ls_fcat-fieldname
INTO ls_fcat-fieldname
SEPARATED BY '-'.
MOVE ls_dfies-keyflag TO ls_fcat-key.
MOVE ls_dfies-scrtext_m TO ls_fcat-seltext_l.
ls_fcat-tabname = me->g_table.
CLEAR: ls_fcat-col_pos,
ls_fcat-offset.
IF ls_fcat-ref_tabname IS INITIAL.
ls_fcat-ddictxt = 'L'.
ENDIF.
* Display Yes/No fields as checkboxes
IF ls_dfies-domname = 'XFELD'.
ls_fcat-checkbox = 'X'.
ENDIF.
* Add field to field catalog
APPEND ls_fcat TO fcat.
ENDLOOP.
ELSE.
* Try to get info about data element
CALL FUNCTION 'DDIF_DTEL_GET'
EXPORTING
name = ls_fcat-ref_fieldname
langu = sy-langu
IMPORTING
dd04v_wa = ls_dd04v
EXCEPTIONS
illegal_input = 1
OTHERS = 2.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dd04v TO ls_fcat.
MOVE: ls_dd04v-scrtext_m TO ls_fcat-seltext_l,
ls_dd04v-domname TO l_dname.
ELSE.
* Finally try to get info about domain
CALL FUNCTION 'DDIF_DOMA_GET'
EXPORTING
name = ls_fcat-ref_fieldname
langu = sy-langu
IMPORTING
dd01v_wa = ls_dd01v
EXCEPTIONS
illegal_input = 1
OTHERS = 2.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dd01v TO ls_fcat.
MOVE: ls_dd01v-ddtext TO ls_fcat-seltext_l,
ls_dd01v-domname TO l_dname.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
* Table name must be internal table containing data
ls_fcat-tabname = g_table.
* No offset
CLEAR: ls_fcat-offset.
* Default text is stored in long text
IF ls_fcat-ref_tabname IS INITIAL.
ls_fcat-ddictxt = 'L'.
ENDIF.
* Display Yes/No fields as checkboxes
IF l_dname = 'XFELD'.
ls_fcat-checkbox = 'X'.
ENDIF.
* Add field to field catalog
APPEND ls_fcat TO fcat.
ENDLOOP.
* Link between fields
DESCRIBE TABLE fcat LINES l_nbfld.
LOOP AT fcat INTO ls_fcat.
IF sy-tabix NE l_nbfld.
l_index = sy-tabix + 1.
READ TABLE fcat INTO ls_fcat2 INDEX l_index.
IF sy-subrc = 0.
IF ls_fcat-datatype = 'CURR'.
* Currency unit
IF ls_fcat2-datatype = 'CUKY'.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ELSE.
LOOP AT fcat INTO ls_fcat2
FROM l_index
WHERE datatype = 'CUKY'.
* First currency unit after field
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
EXIT.
ENDLOOP.
IF sy-subrc NE 0.
* No currency unit after field, try before
READ TABLE fcat INTO ls_fcat2
WITH KEY datatype = 'CUKY'.
IF sy-subrc = 0.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
IF ls_fcat-datatype = 'QUAN'.
* Quantity unit
IF ls_fcat2-datatype = 'UNIT'.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
ENDLOOP.
ENDMETHOD.
***
* Get definition of type from code source
***
METHOD get_definition.
DATA: l_strng TYPE rssource,
ls_abap TYPE rssource,
l_fdpos TYPE i,
l_first TYPE i,
l_lastr TYPE i.
DATA: lt_incl TYPE TABLE OF repid,
ls_incl TYPE repid.
* Get program code
READ REPORT repid INTO abap.
CHECK sy-subrc EQ 0.
* Get first line of definition
CONCATENATE 'BEGIN OF' struc INTO l_strng
SEPARATED BY space.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ', "'.
l_first = sy-tabix.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.
IF l_first IS INITIAL.
* Table is defined in an include
CALL FUNCTION 'RS_GET_ALL_INCLUDES'
EXPORTING
program = repid
TABLES
includetab = lt_incl
EXCEPTIONS
OTHERS = 1.
IF sy-subrc = 0.
LOOP AT lt_incl INTO ls_incl.
* Try to find definition in this include
READ REPORT ls_incl INTO abap.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ',. "'.
l_first = sy-tabix.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.
IF NOT l_first IS INITIAL.
EXIT.
ENDIF.
ENDLOOP.
ENDIF.
ENDIF.
* Get last line of definition
CONCATENATE 'END OF' struc INTO l_strng
SEPARATED BY space.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ',. "'.
l_lastr = sy-tabix - l_first.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.
* Keep only relevant code lines
IF l_first LE 0
OR l_lastr LE 0.
REFRESH abap.
ELSE.
DELETE abap TO l_first.
DELETE abap FROM l_lastr.
ENDIF.
ENDMETHOD.
***
* Get definition of type recursively
***
METHOD recursive_definition.
DATA: lt_token TYPE TABLE OF stokex,
ls_token TYPE stokex,
lt_state TYPE TABLE OF sstmnt,
ls_state TYPE sstmnt.
DATA: ls_defin TYPE ty_defin,
l_reffld TYPE fieldname.
DATA: lt_recu TYPE TABLE OF rssource.
* Retrieve tokens
SCAN ABAP-SOURCE abap
TOKENS INTO lt_token
STATEMENTS INTO lt_state.
LOOP AT lt_state INTO ls_state.
CLEAR: ls_defin.
* Field name
READ TABLE lt_token INTO ls_token
INDEX ls_state-from.
ls_defin-fieldname = ls_token-str.
* Reference type
READ TABLE lt_token INTO ls_token
INDEX ls_state-to.
l_reffld = ls_token-str.
* Check if this type is defined in program
FREE: lt_recu.
CALL METHOD get_definition EXPORTING repid = repid
struc = l_reffld
CHANGING abap = lt_recu.
IF lt_recu IS INITIAL.
IF NOT g_level IS INITIAL.
CONCATENATE g_level ls_defin-fieldname INTO ls_defin-fieldname
SEPARATED BY '-'.
CONDENSE ls_defin-fieldname.
ENDIF.
IF l_reffld CS '-'.
SPLIT l_reffld AT '-'
INTO ls_defin-ref_tabname
ls_defin-ref_fieldname.
IF ls_defin-ref_tabname = 'SY'.
ls_defin-ref_tabname = 'SYST'.
ENDIF.
ELSE.
ls_defin-ref_fieldname = ls_token-str.
ENDIF.
APPEND ls_defin TO me->gt_defin.
ELSE.
* Process sub levels
IF me->g_level IS INITIAL.
me->g_level = ls_defin-fieldname.
ELSE.
CONCATENATE me->g_level ls_defin-fieldname INTO me->g_level
SEPARATED BY '-'.
ENDIF.
CALL METHOD recursive_definition EXPORTING repid = repid
CHANGING abap = lt_recu.
IF me->g_level CS '-'.
SHIFT me->g_level RIGHT UP TO '-'.
SHIFT me->g_level RIGHT.
SHIFT me->g_level LEFT DELETING LEADING space.
ELSE.
CLEAR: me->g_level.
ENDIF.
ENDIF.
ENDLOOP.
ENDMETHOD.
***
* Set table name
***
METHOD set_table_name.
me->g_table = in_tabname.
ENDMETHOD.
***
* Set title
***
METHOD set_alv_title.
me->g_title = in_title.
ENDMETHOD.
***
* Set settings
***
METHOD set_alv_settings.
CALL METHOD map_structure EXPORTING source = in_settings
CHANGING destin = me->gs_sett.
ENDMETHOD.
***
* Set layout
***
METHOD set_alv_layout.
CALL METHOD map_structure EXPORTING source = in_layout
CHANGING destin = me->gs_layo.
ENDMETHOD.
***
* Add event
***
METHOD set_alv_event.
DATA: ls_evnt TYPE slis_alv_event.
ls_evnt-name = in_name.
ls_evnt-form = in_form.
COLLECT ls_evnt INTO gt_evnt.
ENDMETHOD.
***
* Map fields from incoming structure into attribute
***
METHOD map_structure.
DATA: ob_desc TYPE REF TO cl_abap_structdescr,
ls_compo TYPE abap_compdescr.
FIELD-SYMBOLS: <field> TYPE ANY,
<struc> TYPE ANY.
ob_desc ?= cl_abap_typedescr=>describe_by_data( destin ).
LOOP AT ob_desc->components INTO ls_compo.
ASSIGN COMPONENT ls_compo-name OF STRUCTURE source TO <field>.
IF <field> IS ASSIGNED.
ASSIGN COMPONENT ls_compo-name OF STRUCTURE destin TO <struc>.
CATCH SYSTEM-EXCEPTIONS conversion_errors = 1.
MOVE <field> TO <struc>.
ENDCATCH.
UNASSIGN <field>.
ENDIF.
ENDLOOP.
ENDMETHOD.
ENDCLASS.
|