How do we handle BDC table control

hi sap technical guru,
PLS suggest me how to handle BDC table control while uploading data to sap R/3
regards,

Hi,
First take BDC recording for required transaction from SHDB then you will find screen field names, screen numbers sequence, According to that pass values to below BDC_DYNPRO and BDC_FIELD forms and append data to BDC table. In my requirement I have done this for VB03 transaction passed values to VB03 transaction from my selection screen.
*& Report  ZS_VB03_TRANSACTION
REPORT  ZS_VB03_TRANSACTION.
TABLES: KOMGG,                        "Dialogkommunikationstab
T685T,                         "Text zum Konditionsart
T185F,                         "Folgebildsteurung
T681,                          "Konditionstabelle
TMC1T, G000, TPARA.                         "Kurztext zur Konditionstabell
* Sales Organization                                                   *
SELECT-OPTIONS S_F001 FOR KOMGG-VKORG.
*MEMORY ID VKO.
* Distribution Channel                                                 *
SELECT-OPTIONS S_F002 FOR KOMGG-VTWEG
MEMORY ID VTW.
* Division                                                             *
SELECT-OPTIONS S_F003 FOR KOMGG-SPART
MEMORY ID SPA.
* CustomerHierarchy 01                                                 *
SELECT-OPTIONS S_F004 FOR KOMGG-HIENR01.
* Material                                                             *
SELECT-OPTIONS S_F005 FOR KOMGG-MATNR
MEMORY ID MAT
MATCHCODE OBJECT MAT1.
* Customer                                                             *
SELECT-OPTIONS S_F006 FOR KOMGG-KUNNR
MEMORY ID KUN
MATCHCODE OBJECT DEBI.
*                       "Selektionsdatum                               *
SELECTION-SCREEN SKIP 1.
PARAMETERS SEL_DATE LIKE RV130-DATAM
DEFAULT SY-DATLO.
PARAMETERS: r_vb03 TYPE c RADIOBUTTON GROUP rb1 DEFAULT 'X',
r2 type c RADIOBUTTON GROUP rb1.
*    *       Batchinputdata of single transaction
DATA:   BDCDATA LIKE BDCDATA    OCCURS 0 WITH HEADER LINE.
*       messages of call transaction
DATA:   MESSTAB LIKE BDCMSGCOLL OCCURS 0 WITH HEADER LINE.
data: lv TYPE i.
data: s1 type KOMGG-VKORG,
s2 type KOMGG-VKORG.
START-OF-SELECTION.
if r_vb03 = 'X'.
data: num(2) TYPE n VALUE '01',
lv_string(40) type c,
lv_s_f001 like s_f001.
set PARAMETER ID: 'VGK' FIELD 'A001'. "Place ur default value here in A001 place.
If S_f001-high is INITIAL.
perform bdc_field       using 'BDC_CURSOR'
'F001-LOW'.
perform bdc_field       using 'BDC_OKCODE'
'=%003'.
perform bdc_dynpro      using 'SAPLALDB' '3000'.
perform bdc_field       using 'BDC_OKCODE'
'=ACPT'.
perform bdc_field       using 'BDC_CURSOR'
'RSCSEL-SLOW_I(01)'.
loop at S_f001 into lv_s_f001.
CONCATENATE 'RSCSEL-SLOW_I(' num ')' INTO lv_string.
perform bdc_field       using 'BDC_CURSOR'
lv_string.
perform bdc_field       using lv_string
lv_s_f001-low.
clear: lv_s_f001, lv_string.
num = num + 1.
ENDLOOP.
clear num.
perform bdc_dynpro      using 'RV13GAAB' '1000'.
perform bdc_field       using 'BDC_CURSOR'
'F002-LOW'.
ELSE.
perform bdc_dynpro      using 'RV13GAAB' '1000'.
perform bdc_field       using 'BDC_CURSOR'
'F001-LOW'.
perform bdc_field       using 'F001-LOW' S_f001-low.
perform bdc_field       using 'F001-HIGH' S_f001-high.
endif.
perform bdc_field       using 'F002-LOW' S_F002-low.
perform bdc_field       using 'F002-HIGH' S_F002-High.
perform bdc_field       using 'F004-high' S_F004-high.
perform bdc_field       using 'F005-LOW' S_F005-low.
perform bdc_field       using 'F003-LOW' S_F003-low.
perform bdc_field       using 'F003-High' S_F003-high.
perform bdc_field       using 'F004-LOW' S_F004-low.
perform bdc_field       using 'F005-high' S_F005-high.
perform bdc_field       using 'F006-LOW' S_F006-low.
perform bdc_field       using 'F006-high' S_F006-high.
call TRANSACTION 'VB03' USING BDCDATA MODE 'E' MESSAGES INTO MESSTAB.
ENDIF.
*        Start new screen                                              *
FORM BDC_DYNPRO USING PROGRAM DYNPRO.
CLEAR BDCDATA.
BDCDATA-PROGRAM  = PROGRAM.
BDCDATA-DYNPRO   = DYNPRO.
BDCDATA-DYNBEGIN = 'X'.
APPEND BDCDATA.
ENDFORM.
*        Insert field                                                  *
FORM BDC_FIELD USING FNAM FVAL.
CLEAR BDCDATA.
BDCDATA-FNAM = FNAM.
BDCDATA-FVAL = FVAL.
APPEND BDCDATA.
ENDFORM.

Similar Messages

  • Hi All, How we can handle a table control in bdc - in detail its urgent pls

    Hi All, How we can handle a table control in bdc - in detail its urgent. Please send me the explanation in detail.
    Thanks&regards.
    Bharat

    hi,
    Create Table Control
    • Step 1 (Create new structure for table control)
    Type is name of structure (ZTC_EKKO) and press create
    • Step 2 (Create Program)
    Goto transaction SE80(Object Navigator) -> Repository Browser -> Program.
    Enter your program name, please ensure that is begins with SAPMZ…… as this is a module pool (dialog program).
    Press enter to create, and press yes!
    Ensure that you create a top include, and press Enter.
    Accept the name created for the top include.
    Press Enter.
    Press Save
    • Step 3 (Create TOP include)
    Double click on the top include and enter following ABAP code:
    Tables: ZTC_EKKO.
    controls: tc100 type tableview using screen 100.
    data: ok_code type sy-ucomm.
    data: it_ekko type standard
    table of ZTC_EKKO initial size 0,
    wa_ekko type ZTC_EKKO.
    data: ok_code type sy-ucomm.
    Press Save and Activate
    • Step 4 (Create screen)
    Right click the program to create a screen 100 for the dialog. Enter Short description, set screen type to Normal and enter 0 or blank into Next screen. Then move to Element List tab and enter the OK code as OK_CODE (i.e. the same as what you declared in the top include with data: ok_code type sy-ucomm).
    • Step 5 (Create table control)
    Press the Layout button to bring up the screen painter editor.
    Press table control button and drag it on to the screen, enter the name of table control created in TOP include (TC100). Now press the yellow button for attributes and set the table control as below options
    • Step 6 (Populate table control )
    Press the orange button (Fields). On the next screen enter ZTC_EKKO and press the ‘Get from Dict’ button. Select the fields you want (all) and press enter. Now drag them onto your Table Control.
    Below is the result, there will been syntax errors if we check now! So Save and go back into the flow logic tab.
    • Step 7 (Create flow control )
    Within the flow logic of screen 100 and create two modules, one to select the data from the database and the other to move the selected fields into the table control. Also insert the two loop statements to populate and retrieve the lines of the table control.
    PROCESS BEFORE OUTPUT.
    MODULE STATUS_0100.
    module data_retrieval.
    loop at it_ekko into wa_ekko with control TC100.
    module populate_screen.
    endloop.
    PROCESS AFTER INPUT.
    loop at it_ekko.
    endloop.
    MODULE USER_COMMAND_0100.
    Double click the module data_retrieval to create and click yes to get past the popup. Ensure that a new include is created to hold all the PBO modules (default). Press enter.
    Select 10 rows of data from the EKKO table and load into the internal table it_ekko. Go back to the flow logic to load this data into the Table Control.
    check this one
    REPORT ZCALL_TRANS_TAB1 .
    TABLES: LFA1,LFBK,lfb1.
    data: BEGIN OF it_vendor occurs 0,
    LIFNR LIKE LFA1-LIFNR,
    bukrs like lfb1-bukrs,
    END OF it_vendor.
    DATA: BEGIN OF IT_BANK occurs 0,
    LIFNR LIKE LFA1-LIFNR,
    BANKS LIKE LFBK-BANKS,
    BANKL LIKE LFBK-BANKL,
    BANKN LIKE LFBK-BANKN,
    koinh like lfbk-koinh,
    END OF IT_BANK.
    data: it_bdcdata like bdcdata occurs 0 with header line.
    data: it_messages like bdcmsgcoll occurs 0 with header line.
    *selection screen.
    selection-screen: begin of block b1 with frame.
    parameters: p_file like rlgrap-filename default 'c:/vendor.txt'
    obligatory.
    parameters: p_file1 like rlgrap-filename default 'c:/xyz.txt'
    obligatory.
    selection-screen: end of block b1.
    *at selection screen.
    at selection-screen on value-request for p_file.
    perform f4_help using p_file.
    at selection-screen on value-request for p_file1.
    perform f4_help1 using p_file1.
    *start of selection
    start-of-selection.
    *******uploading file
    perform upload_file using p_file P_FILE1.
    ******open session.
    perform populate_data.
    *& Form f4_help
    form f4_help using p_p_file.
    data: l_file type ibipparms-path.
    call function 'F4_FILENAME'
    importing
    file_name = l_file.
    p_file = l_file.
    endform. " f4_help
    *& Form POPULATE_DATA
    form populate_data .
    DATA: L_STRING TYPE STRing.
    DATA: L_COUNTER(2) TYPE n.
    loop at it_vendor.
    perform bdc_dynpro using 'SAPMF02K' '0106'.
    perform bdc_field using 'BDC_CURSOR'
    'RF02K-D0130'.
    perform bdc_field using 'BDC_OKCODE'
    '/00'.
    perform bdc_field using 'RF02K-LIFNR'
    it_vendor-lifnr.
    perform bdc_field using 'RF02K-BUKRS'
    it_vendor-bukrs.
    perform bdc_field using 'RF02K-D0130'
    'X'.
    perform bdc_dynpro using 'SAPMF02K' '0130'.
    perform bdc_field using 'BDC_CURSOR'
    'LFBK-bankn(03)'.
    perform bdc_field using 'BDC_OKCODE'
    '=UPDA'.
    *********bank details
    CLEAR l_COUNTER.
    LOOP AT IT_BANK WHERE LIFNR = IT_VENDOR-LIFNR.
    l_COUNTER = l_COUNTER + 1.
    clear l_string.
    CONCATENATE 'lfbk-banks(' l_counter ')' into l_string.
    perform bdc_field using l_string
    it_bank-banks.
    clear l_string.
    CONCATENATE 'lfbk-bankl(' l_counter ')' into l_string.
    perform bdc_field using l_string
    it_bank-bankl.
    clear l_string.
    CONCATENATE 'lfbk-bankn(' l_counter ')' into l_string.
    perform bdc_field using l_string
    it_bank-bankn.
    endloop.
    ******CALL TRANSACTION.
    call transaction 'FK02' using it_bdcdata mode 'A'
    messages into it_messages.
    write:/ sy-subrc.
    perform format_messages.
    clear it_bdcdata.
    refresh it_bdcdata.
    endloop.
    endform. " POPULATE_DATA
    *& Form FORMAT_MESSAGES
    form format_messages .
    data: l_msg(100).
    loop at it_messages.
    call function 'FORMAT_MESSAGE'
    exporting
    id = it_messages-msgid
    lang = sy-langu
    no = it_messages-msgnr
    v1 = it_messages-msgv1
    v2 = it_messages-msgv2
    v3 = it_messages-msgv3
    v4 = it_messages-msgv4
    importing
    msg = l_msg
    exceptions
    not_found = 1
    others = 2
    write:/ l_msg.
    endloop.
    endform. " FORMAT_MESSAGES
    *& Form bdc_dynpro
    form bdc_dynpro using value(p_program)
    value(p_screen).
    it_bdcdata-program = p_program.
    it_bdcdata-dynpro = p_screen.
    it_bdcdata-dynbegin = 'X'.
    append it_bdcdata.
    clear it_bdcdata.
    endform. " bdc_dynpro
    *& Form bdc_field
    form bdc_field using value(p_fnam)
    value(p_fval).
    it_bdcdata-fnam = p_fnam.
    it_bdcdata-fval = p_fval.
    append it_bdcdata.
    clear it_bdcdata.
    endform. " bdc_field
    *& Form upload_file
    form upload_file using p_p_file
    p_p_file1.
    CALL FUNCTION 'WS_UPLOAD'
    EXPORTING
    CODEPAGE = ' '
    FILENAME = P_P_FILE
    FILETYPE = 'DAT'
    HEADLEN = ' '
    LINE_EXIT = ' '
    TRUNCLEN = ' '
    USER_FORM = ' '
    USER_PROG = ' '
    DAT_D_FORMAT = ' '
    IMPORTING
    FILELENGTH =
    TABLES
    data_tab = IT_VENDOR
    EXCEPTIONS
    CONVERSION_ERROR = 1
    FILE_OPEN_ERROR = 2
    FILE_READ_ERROR = 3
    INVALID_TYPE = 4
    NO_BATCH = 5
    UNKNOWN_ERROR = 6
    INVALID_TABLE_WIDTH = 7
    GUI_REFUSE_FILETRANSFER = 8
    CUSTOMER_ERROR = 9
    NO_AUTHORITY = 10
    OTHERS = 11
    IF sy-subrc <> 0.
    MESSAGE I000(ZZ) WITH 'UNABLE TO UPLOAD'.
    STOP.
    ENDIF.
    *******UPLOADING BANK DETAILS
    CALL FUNCTION 'WS_UPLOAD'
    EXPORTING
    CODEPAGE = ' '
    FILENAME = P_P_FILE1
    FILETYPE = 'DAT'
    HEADLEN = ' '
    LINE_EXIT = ' '
    TRUNCLEN = ' '
    USER_FORM = ' '
    USER_PROG = ' '
    DAT_D_FORMAT = ' '
    IMPORTING
    FILELENGTH =
    TABLES
    data_tab = IT_BANK
    EXCEPTIONS
    CONVERSION_ERROR = 1
    FILE_OPEN_ERROR = 2
    FILE_READ_ERROR = 3
    INVALID_TYPE = 4
    NO_BATCH = 5
    UNKNOWN_ERROR = 6
    INVALID_TABLE_WIDTH = 7
    GUI_REFUSE_FILETRANSFER = 8
    CUSTOMER_ERROR = 9
    NO_AUTHORITY = 10
    OTHERS = 11
    IF sy-subrc <> 0.
    MESSAGE I000(ZZ) WITH 'UNABLE TO UPLOAD'.
    STOP.
    ENDIF.
    endform. " upload_file
    *& Form f4_help1
    -->P_P_FILE1 text
    form f4_help1 using p_p_file1.
    data:l_file1 type ibipparms-path.
    CALL FUNCTION 'F4_FILENAME'
    IMPORTING
    FILE_NAME = l_file1.
    p_file1 = l_file1.
    endform. " f4_help1
    http://sap-img.com/abap/bdc-example-using-table-control-in-bdc.htm
    Regards,
    Sankar

  • How to transfer data in table control in bdc

    hi
    how to transfer data in table control in bdc . I need the theory regarding this
    bye

    Hi,
    just check in the forum , there is many threads available to ur questions.
    Table control in BDC
    http://www.sap-img.com/abap/bdc-example-using-table-control-in-bdc.htm
    You can even refer to these related threads
    bdc table control
    Re: table control in bdc
    table control in BDC
    Reward if helpful.
    Thanks
    Naveen khan

  • How to handle the table control in bapi?

    how to handle the table control in bapi? example va01.
    i pass multiple line item what is the procedure?
    header detail same .
    eample ship to party
           sale to party.
    line item mulptiple
    10 mat1
    2o mat2
    30 mat3.
    in bapi we can pass sinle line item.
    any way to handle multiple line item pass through the bapi.
    Message was edited by:
            Karthikeyan Pandurangan

    BAPI is not going through the screen flow logic so you need not to worry about the table control. Just check in the BAPi there must be one table parameter for line items just pass one int table with your data to that table parameter it will automatically update the tables.
    Regards
    shiba dutta

  • How to create screen resolution in bdc table control

    hi gurus
    can anyone suggest me
    how to create screen resolution in bdc table control
    thanks&regards
    mark.

    Hi ,
    Using CTU_PARAMS table for screen resolution .
    For this sample code.
    This is for Transation  FB60.
    report ZZFB60
           no standard page heading line-size 255.
    tables t100.
    PARAMETERS : p_file1  like  rlgrap-filename,
                 p_doctyp like  RF05A-BUSCS,
                 p_invdat like  INVFO-BLDAT,
                 p_posdat like  INVFO-BUDAT.
    CONSTANTS  :  C_TRANS_FB60(4) VALUE 'FB60'.
    *Parameter string for runtime of CALL TRANSACTION
    data : l_option type ctu_params,
           l_subrc type sysubrc.
    DATA :  l_mstring(150).
    data      accnt type char17.
    data       : day   type char2,
                 month type char2,
                 year  type char4,
                 date1 type char10,
                 date2 type char10.
    data      :  cnt(2) TYPE n,
                 cnt1 type i,
                 fld(25) TYPE c.
    data : begin of excel occurs 0,
            fieldname(255) type c,
           end of excel.
    DATA:BEGIN OF it_mess OCCURS 0,
             msgtyp(5),
             lms(200),
              msgv1(50),
         END OF it_mess.
    data: begin of t_record occurs 0,
             BUKRS(004),
            ACCNT(017),
            XBLNR(016),
            WRBTR1(016),
            WAERS(005),
            SECCO(004) ,
            SGTXT(050),
            HKONT(010),
            WRBTR2(017),
            MWSKZ(002),
            GSBER(004),
            KOSTL(010),
         end of t_record.
    *Internal Table for Header Data
    DATA :  BEGIN OF t_head OCCURS 0,
            BUKRS(004),      "Company Code
            ACCNT(017),      "Account or Vendor
            XBLNR(016),      "Reference
            WRBTR1(017),     "Amount in document currency
            WAERS(005),      "Currency
            SECCO(004),      "Section Code
            SGTXT(050),      "Text
            END OF t_head.
    *Internal table for Item Data
    DATA :  BEGIN OF t_item OCCURS 0,
            ACCNT(017),      "Account
            HKONT(010),     "GL Account
            WRBTR2(017),    "Line item Amount in document currency
            MWSKZ(002),     "Tax Code
            GSBER(004),     " Business Area
            KOSTL(010),     "Cost centre
            END OF t_item.
    DATA: IT_BDCDATA      LIKE  BDCDATA OCCURS 0 WITH HEADER LINE,
          IT_BDC_MESSAGES LIKE  BDCMSGCOLL OCCURS 0 WITH HEADER LINE.
    *include bdcrecx1.
    AT SELECTION-SCREEN ON VALUE-REQUEST FOR p_file1.
      PERFORM  file_selection.
      PERFORM  data_upload.
      PERFORM  table_control.
    start-of-selection.
    l_option-defsize = 'X'.
    l_option-dismode = 'A'.
    l_option-updmode = 'S'.
    day = p_invdat+6(2).
    month = p_invdat+4(2).
    year =  p_invdat+0(4).
    concatenate day month year into date1 SEPARATED BY '.'.
    day = p_posdat+6(2).
    month = p_posdat+4(2).
    year =  p_posdat+0(4).
    concatenate day month year into date2 SEPARATED BY '.'.
    *perform open_group.
    loop at t_head.
    CLEAR    IT_BDCDATA.
    REFRESH  IT_BDCDATA.
    perform bdc_dynpro      using   'SAPLACHD'         '1000'.
    perform bdc_field       using   'BDC_OKCODE'        '=ENTR'.
    perform bdc_field       using   'BKPF-BUKRS'        t_head-bukrs.
    perform bdc_dynpro      using   'SAPMF05A'          '1100'.
    perform bdc_field       using   'BDC_OKCODE'        '/00'.
    perform bdc_field       using   'RF05A-BUSCS'       p_doctyp.
    perform bdc_field       using   'INVFO-ACCNT'       t_head-accnt.
    perform bdc_field       using   'INVFO-BLDAT'       date1.
    perform bdc_field       using   'INVFO-BUDAT'       date2.
    perform bdc_field       using   'INVFO-XBLNR'       t_head-xblnr.
    perform bdc_field       using   'INVFO-WRBTR'       t_head-wrbtr1.
    perform bdc_field       using   'INVFO-WAERS'       t_head-waers.
    perform bdc_field       using   'INVFO-SECCO'       t_head-secco.
    perform bdc_field       using   'INVFO-SGTXT'       t_head-sgtxt.
    cnt = 1.
    cnt1 = 1.
    loop at t_item where accnt = t_head-accnt.
    *if cnt > 4.
    *cnt = 4.
    *endif.
    if cnt1 gt 1.
    CONCATENATE 'ACGL_ITEM-MARKSP(' cnt ')' INTO fld.
    perform bdc_field      using   fld                   'X'.
    perform bdc_dynpro      using 'SAPMF05A'          '1100'.
    perform bdc_field       using 'BDC_OKCODE'        '=0005'.
    endif.
    perform bdc_dynpro      using 'SAPMF05A'          '1100'.
    perform bdc_field       using   'BDC_OKCODE'        '/00'.
    CONCATENATE 'ACGL_ITEM-HKONT(' cnt ')' INTO fld.
    perform bdc_field       using  fld                t_item-hkont.
    CONCATENATE 'ACGL_ITEM-WRBTR(' cnt ')' INTO fld.
    perform bdc_field  using       fld                t_item-wrbtr2.
    CONCATENATE 'ACGL_ITEM-MWSKZ(' cnt ')' INTO fld.
    perform bdc_field       using  fld                t_item-mwskz.
    CONCATENATE 'ACGL_ITEM-GSBER(' cnt ')' INTO fld.
    perform bdc_field       using  fld                t_item-gsber.
    CONCATENATE 'ACGL_ITEM-KOSTL(' cnt ')' INTO fld.
    perform bdc_field       using  fld                t_item-kostl.
    perform bdc_field      using  'BDC_CURSOR'  fld.
    *CONCATENATE 'ACGL_ITEM-MARKSP(' cnt ')' INTO fld.
    *perform bdc_field      using   fld                   'X'.
    cnt1 = cnt1 + 1.
    *cnt = cnt + 1.
    *if cnt > 1.
    *perform bdc_dynpro      using 'SAPMF05A'          '1100'.
    *perform bdc_field       using 'BDC_OKCODE'        '=0005'.
    **perform bdc_field       using 'BDC_OKCODE'        '=0006'.
    *endif.
    endloop.
    perform bdc_dynpro      using 'SAPMF05A' '1100'.
    perform bdc_field       using 'BDC_OKCODE'
                                  '=BS'.
    perform bdc_dynpro      using 'SAPMSSY0' '0120'.
    perform bdc_field       using 'BDC_OKCODE'
                                  '=BU'.
    *perform bdc_transaction using 'FB60'.
    CALL TRANSACTION C_TRANS_FB60 USING IT_BDCDATA  options from l_option
                                 MESSAGES INTO IT_BDC_MESSAGES.
    perform error.
    perform errordownload.
    endloop.
    *perform close_group.
    *Form  data_upload
    FORM data_upload .
    CALL FUNCTION 'WS_UPLOAD'
    EXPORTING
       FILENAME              =  p_file1
       FILETYPE              = 'DAT'
      TABLES
        DATA_TAB             =  t_record.
    ENDFORM.                    " data_upload
    *Form  file_selection
    FORM file_selection .
    CALL FUNCTION 'F4_FILENAME'
        EXPORTING
          program_name  =  syst-cprog
          dynpro_number =  syst-dynnr
          field_name    = 'p_file1'
        IMPORTING
          file_name     =  p_file1.
    ENDFORM.                    " file_selection
    Form  BDC_DYNPRO
    FORM BDC_DYNPRO using program dynpro.
      CLEAR IT_BDCDATA.
      IT_BDCDATA-PROGRAM = PROGRAM.
      IT_BDCDATA-DYNPRO = DYNPRO.
      IT_BDCDATA-DYNBEGIN = 'X'.
      APPEND  IT_BDCDATA.
    endform.
    *Form  BDC_FIELD
    FORM  bdc_field using fnam fval.
      CLEAR  IT_BDCDATA.
      IT_BDCDATA-FNAM = FNAM.
      IT_BDCDATA-FVAL = FVAL.
      APPEND  IT_BDCDATA.
    ENDFORM.
    Table Control
    FORM table_control .
      LOOP AT t_record.
        ON CHANGE OF t_record-accnt.
          MOVE-CORRESPONDING t_record TO t_head.
          APPEND t_head.
        ENDON.
      loop at t_head.
             t_item-accnt   =  t_head-accnt.
             t_item-hkont   =  t_record-hkont.
             t_item-wrbtr2  =  t_record-wrbtr2 .
             t_item-mwskz   =  t_record-mwskz .
             t_item-gsber   =  t_record-gsber .
             t_item-kostl   =  t_record-kostl.
        APPEND t_item.
    endloop.
         If t_record-level = 'H'.
             t_head-bukrs   =  t_record-text1.
             t_head-accnt   =  t_record-text2.
             t_head-xblnr   =  t_record-text3.
             t_head-wrbtr1  =  t_record-text4.
             t_head-waers   =  t_record-text5.
             t_head-secco   =  t_record-text6.
             t_head-sgtxt   =  t_record-text7.
          APPEND t_head.
         else.
            t_item-accnt   =  t_head-accnt.
            t_item-hkont   =  t_record-text1.
            t_item-wrbtr2  =  t_record-text2.
            t_item-mwskz   =  t_record-text3.
            t_item-gsber   =  t_record-text4.
            t_item-kostl   =  t_record-text5.
         APPEND t_item.
         endif.
      ENDLOOP.
    ENDFORM.
    FORM error .
      LOOP AT IT_BDC_MESSAGES.
        IF IT_BDC_MESSAGES-msgtyp = 'E'.
       SELECT single  * FROM t100  WHERE
                                    sprsl = it_BDC_MESSAGES-msgspra
                                    AND   arbgb = IT_BDC_MESSAGES-msgid
                                    AND   msgnr = IT_BDC_MESSAGES-msgnr.
          IF sy-subrc = 0.
            l_mstring = t100-text.
            IF l_mstring CS '&1'.
              REPLACE '&1' WITH IT_BDC_MESSAGES-msgv1 INTO l_mstring.
              REPLACE '&2' WITH IT_BDC_MESSAGES-msgv2 INTO l_mstring.
              REPLACE '&3' WITH IT_BDC_MESSAGES-msgv3 INTO l_mstring.
              REPLACE '&4' WITH IT_BDC_MESSAGES-msgv4 INTO l_mstring.
            ELSE.
              REPLACE '&' WITH IT_BDC_MESSAGES-msgv1 INTO l_mstring.
              REPLACE '&' WITH IT_BDC_MESSAGES-msgv2 INTO l_mstring.
              REPLACE '&' WITH IT_BDC_MESSAGES-msgv3 INTO l_mstring.
              REPLACE '&' WITH IT_BDC_MESSAGES-msgv4 INTO l_mstring.
            ENDIF.
            CONDENSE l_mstring.
            it_mess-msgtyp = IT_BDC_MESSAGES-msgtyp.
            it_mess-lms = l_mstring.
            it_mess-msgv1 = IT_BDC_MESSAGES-msgv1.
            APPEND it_mess.
          ELSE.
            it_mess-msgtyp = IT_BDC_MESSAGES-msgtyp.
            it_mess-lms = l_mstring.
            it_mess-msgv1 = IT_BDC_MESSAGES-msgv1.
            APPEND it_mess.
          ENDIF.
        ENDIF.
      ENDLOOP.
    ENDFORM.
    form errordownload.
    *down the internal table to excel file.
    call function 'EXCEL_OLE_STANDARD_DAT'
               EXPORTING
                    file_name                 = 'c:/Error.xls'
               TABLES
                    data_tab                  = it_mess
                    fieldnames                = excel
               EXCEPTIONS
                    file_not_exist            = 1
                    filename_expected         = 2
                    communication_error       = 3
                    ole_object_method_error   = 4
                    ole_object_property_error = 5
                    invalid_filename          = 6
                    invalid_pivot_fields      = 7
                    download_problem          = 8
                    others                    = 9.
    endform.
    Reward if useful
    Regards,
    Narasimha
    Edited by: narasimha marella on May 13, 2008 12:12 PM

  • How to handle the table control While working with LSMW?

    How to handle the table control While working with LSMW?

    its possible in lsmw,
    Hi,
    LSMW will have a Indicator for headr and itam, i do not remember the correct field, but it will have an indicator, check the fields, there will be a single charecter lenght field, that should be the indicator, and using that we can write the logic.
    check that single charecter field, it that is X that means the header record is processed, and do the items.
    and, this is another way, try this out also
    YOu can do this in "Define Source Structures" step,
    the HEADER is defined first,
    then the DETAIL below the HEADER.
    add the fields to the structures.
    Both should have some common key field
    Please take care that the name of the common field is the same.
    Once you do this it is linked. The you have a header and item corresponding to that header. then run the LSMW as you would.
    Thanks

  • Error Handling in table control for line item.

    Hi,
    Please how to do error handling in table control for line item in bdc,i have used format_message for header but i don't no fill decamps internal tabled and  how to do background processing in call transaction.
    Thanks

    Background processing is not possible using call transaction method.
    You can create an executable program which can have CALL TRANSACTION BDC code. And this can be run in background.
    What do you exactly mean by Error handling for Items in table control. Can you give some more details.

  • BDC Table Controler

    hi friends,
    Could u please tell me what BDC TABLE CONTROLER
    in which cases we can use the bdc Table Contorler
    Regards
    srinu y

    Hi srinu,
    <b>Check this link</b>
    http://www.sap-basis-abap.com/abap/handling-table-control-in-bdc.htm
    How to deal with table control / step loop in BDC
    <b>Steploop</b> and <b>table contol</b> is inevitable in certain transactions. When we run BDC for such transactions, we will face the situation: how many visible lines of steploop/tablecontrol are on the screen? Although we can always find certain method to deal with it, such as function code 'NP', 'POPO', considering some extreme situation: there is only one line visible one the screen, our BDC program should display an error message. (See transaction 'ME21', we you resize your screen to let only one row visible, you can not enter mutiple lines on this screen even you use 'NP')
    Now with the help of Poonam on sapfans.com developement forum, I find a method with which we can determine the number of visible lines on Transaction Screen from our Calling BDC program. Maybe it is useless to you, but I think it will give your some idea.
    Demo <b>ABAP code</b> has two purposes:
    <b>1.</b> how to determine number of visible lines and how to calculte page number;
    (the 'calpage' routine has been modify to meet general purpose usage)
    <b>2.</b> using field symbol in BDC program, please pay special attention to the difference in Static ASSIGN and Dynamic ASSIGN.
    Now I begin to describe the step to implement my method:
    (I use transaction 'ME21', screen 121 for sample,
    the method using is Call Transation Using..)
    <b>Step1:</b> go to screen painter to display the screen 121, then we can count the fixed line on this screen, there is 7 lines above the steploop and 2 lines below the steploop, so there are total 9 fixed lines on this screen. This means except these 9 lines, all the other line is for step loop. Then have a look at steploop itselp, one entry of it will occupy two lines.
    (Be careful, for table control, the head and the bottom scroll bar will possess another two fixed lines, and there is a maximum number for table line)
    Now we have : FixedLine = 9
    LoopLine = 2(for table control, LoopLine is always equal to 1)
    <b>Step2:</b> go to transaction itself(ME21) to see how it roll page, in ME21, the first line of new page is always occupied by the last line of last page, so it begin with index '02', but in some other case, fisrt line is empty and ready for input.
    Now we have: FirstLine = 0
    or FirstLine = 1 ( in our case, FirstLine is 1 because the first line of new page is fulfilled)
    <b>Step3:</b> write a subroutine calcalculating number of pages
    (here, the name of actual parameter is the same as formal parameter)
    <b>global data:</b> FixedLine type i, " number of fixed line on a certain screen
    LoopLine type i, " the number of lines occupied by one steploop item
    FirstLine type i, " possbile value 0 or 1, 0 stand for the first line of new " scrolling screen is empty, otherwise is 1
    Dataline type i, " number of items you will use in BDC, using DESCRIBE to get
    pageno type i, " you need to scroll screen how many times.
    line type i, " number of lines appears on the screen.
    index(2) type N, " the screen index for certain item
    begin type i, " from parameter of loop
    end type i. " to parameter of loop
    *in code sample, the DataTable-linindex stands for the table index number of this line
    form calpage using FixedLine type i (see step 1)
    LoopLine type i (see step 1)
    FirstLine type i (see step 2)
    DataLine type i ( this is the item number you will enter in transaction)
    changing pageno type i (return the number of page, depends on run-time visible line in table control/ Step Loop)
    changing line type i.(visible lines one the screen)
    data: midd type i,
    vline type i, "visible lines
    if DataLine eq 0.
    Message eXXX.
    endif.
    vline = ( sy-srows - FixedLine ) div LoopLine.
    *for table control, you should compare vline with maximum line of
    *table control, then take the small one that is min(vline, maximum)
    *here only illustrate step loop
    if FirstLine eq 0.
    pageno = DataLine div vline.
    if pageno eq 0.
    pageno = pageno + 1.
    endif.
    elseif FirstLine eq 1.
    pageno = ( DataLine - 1 ) div ( vline - 1 ) + 1.
    midd = ( DataLine - 1 ) mod ( vline - 1).
    if midd = 0 and DataLine gt 1.
    pageno = pageno - 1.
    endif.
    endif.
    line = vline.
    endform.
    <b>Step4</b> write a subroutine to calculate the line index for each item.
    form calindex using Line type i (visible lines on the screen)
    FirstLine type i(see step 2)
    LineIndex type i(item index)
    changing Index type n. (index on the screen)
    if FirstLine = 0.
    index = LineIndex mod Line.
    if index = '00'.
    index = Line.
    endif.
    elseif FirstLine = 1.
    index = LineIndex mod ( Line - 1 ).
    if ( index between 1 and 0 ) and LineIndex gt 1.
    index = index + Line - 1.
    endif.
    if Line = 2.
    index = index + Line - 1.
    endif.
    endif.
    endform.
    <b>Step5</b> write a subroutine to calculate the loop range.
    form calrange using Line type i ( visible lines on the screen)
    DataLine type i
    FirstLine type i
    loopindex like sy-index
    changing begin type i
    end type i.
    If FirstLine = 0.
    if loopindex = 1.
    begin = 1.
    if DataLine <= Line.
    end = DataLine.
    else.
    end = Line.
    endif.
    elseif loopindex gt 1.
    begin = Line * ( loopindex - 1 ) + 1.
    end = Line * loopindex.
    if end gt DataLine.
    end = DataLine.
    endif.
    endif.
    elseif FirstLine = 1.
    if loopindex = 1.
    begin = 1.
    if DataLine <= Line.
    end = DataLine.
    else.
    end = Line.
    endif.
    elseif loop index gt 1.
    begin = ( Line - 1 ) * ( loopindex - 1 ) + 2.
    end = ( Line - 1 ) * ( loopindex - 1 ) + Line.
    if end gt DataLine.
    end = DataLine.
    endif.
    endif.
    endif.
    endform.
    <b>Step6</b> using field sysbol in your BDC, for example: in ME21, but you should calculate each item will correponding to which index in steploop/Table Control
    form creat_bdc.
    field-symbols: <material>, <quan>, <indicator>.
    data: name1(14) value 'EKPO-EMATN(XX)',
    name2(14) value 'EKPO-MENGE(XX)',
    name3(15) value 'RM06E-SELKZ(XX)'.
    assign: name1 to <material>,
    name2 to <quan>,
    name3 to <indicator>.
    do pageno times.
    if sy-index gt 1
    *insert scroll page ok_code"
    endif.
    perform calrange using Line DataLine FirstLine sy-index
    changing begin end.
    loop at DataTable from begin to end.
    perform calindex using Line FirstLine DataTable-LineIndex changing Index.
    name1+11(2) = Index.
    name2+11(2) = Index.
    name3+12(2) = Index.
    perform bdcfield using <material> DataTable-matnr.
    perform bdcfield using <quan> DataTable-menge.
    perform bdcfield using <indicator> DataTable-indicator.
    endloop.
    enddo.
    Reward with points if it is helpful
    Cheers
    Alfred

  • How can i extend the table control while transfering the data

    hi
    how can i extend the table control while transfering the data.

    Hi,
    For table control we have to handle the page down (P+, or what ever function codes are assigned to that activity) activity with our coding.
    Just check out this code:
    This is the bdc to update the XK01 transaction code (Vendor Creation).
    Here we will use table controls for bankings. Here Iam sending the coding and text files.
    Coding
    REPORT zprataptable2
    NO STANDARD PAGE HEADING LINE-SIZE 255.
    DATA : BEGIN OF itab OCCURS 0,
    i1 TYPE i,
    lifnr LIKE rf02k-lifnr,
    bukrs LIKE rf02k-bukrs,
    ekorg LIKE rf02k-ekorg,
    ktokk LIKE rf02k-ktokk,
    anred LIKE lfa1-anred,
    name1 LIKE lfa1-name1,
    sortl LIKE lfa1-sortl,
    land1 LIKE lfa1-land1,
    akont LIKE lfb1-akont,
    fdgrv LIKE lfb1-fdgrv,
    waers LIKE lfm1-waers,
    END OF itab.
    DATA : BEGIN OF jtab OCCURS 0,
    j1 TYPE i,
    banks LIKE lfbk-banks,
    bankl LIKE lfbk-bankl,
    bankn LIKE lfbk-bankn,
    END OF jtab.
    DATA : cnt(4) TYPE n.
    DATA : fdt(20) TYPE c.
    DATA : c TYPE i.
    INCLUDE bdcrecx1.
    START-OF-SELECTION.
    CALL FUNCTION 'WS_UPLOAD'
    EXPORTING
    filename = 'C:\first1.txt'
    filetype = 'DAT'
    TABLES
    data_tab = itab.
    CALL FUNCTION 'WS_UPLOAD'
    EXPORTING
    filename = 'C:\second.txt'
    filetype = 'DAT'
    TABLES
    data_tab = jtab.
    LOOP AT itab.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0100'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'RF02K-KTOKK'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_field USING 'RF02K-LIFNR'
    itab-lifnr.
    PERFORM bdc_field USING 'RF02K-BUKRS'
    itab-bukrs.
    PERFORM bdc_field USING 'RF02K-EKORG'
    itab-ekorg.
    PERFORM bdc_field USING 'RF02K-KTOKK'
    itab-ktokk.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0110'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFA1-LAND1'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_field USING 'LFA1-ANRED'
    itab-anred.
    PERFORM bdc_field USING 'LFA1-NAME1'
    itab-name1.
    PERFORM bdc_field USING 'LFA1-SORTL'
    itab-sortl.
    PERFORM bdc_field USING 'LFA1-LAND1'
    itab-land1.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0120'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFA1-KUNNR'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0130'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFBK-BANKN(01)'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=ENTR'.
    cnt = 0.
    LOOP AT jtab WHERE j1 = itab-i1.
    cnt = cnt + 1.
    CONCATENATE 'LFBK-BANKS(' cnt ')' INTO fdt.
    PERFORM bdc_field USING fdt jtab-banks.
    CONCATENATE 'LFBK-BANKL(' cnt ')' INTO fdt.
    PERFORM bdc_field USING fdt jtab-bankl.
    CONCATENATE 'LFBK-BANKN(' cnt ')' INTO fdt.
    PERFORM bdc_field USING fdt jtab-bankn.
    IF cnt = 5.
    cnt = 0.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0130'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFBK-BANKS(01)'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=P+'.  " Page down activity
    PERFORM bdc_dynpro USING 'SAPMF02K' '0130'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFBK-BANKN(02)'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=ENTR'.
    ENDIF.
    ENDLOOP.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0130'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFBK-BANKS(01)'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=ENTR'.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0210'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFB1-FDGRV'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_field USING 'LFB1-AKONT'
    itab-akont.
    PERFORM bdc_field USING 'LFB1-FDGRV'
    itab-fdgrv.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0215'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFB1-ZTERM'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0220'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFB5-MAHNA'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0310'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'LFM1-WAERS'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '/00'.
    PERFORM bdc_field USING 'LFM1-WAERS'
    itab-waers.
    PERFORM bdc_dynpro USING 'SAPMF02K' '0320'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'RF02K-LIFNR'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=ENTR'.
    PERFORM bdc_dynpro USING 'SAPLSPO1' '0300'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=YES'.
    PERFORM bdc_transaction USING 'XK01'.
    ENDLOOP.
    PERFORM close_group.
    **Flat files for the above code***
    Intial screen data file.
    1 63190 0001 0001 0001 mr bal188 b in 31000 a1 inr
    2 63191 0001 0001 0001 mr bal189 b in 31000 a1 inr
    Table control Data:
    1 in sb 11000
    1 in sb 12000
    1 in sb 13000
    1 in sb 14000
    1 in sb 15000
    1 in sb 16000
    1 in sb 17000
    1 in sb 18000
    1 in sb 19000
    1 in sb 20000
    1 in sb 21000
    1 in sb 22000
    2 in sb 21000
    2 in sb 22000
    Regards,
    Kumar.

  • BDC table control using Excel sheet upload

    Hi All,
    I am working BDC table control.I want to upload the From excel sheet.I am using the FM ALSM_EXCEL_TO_INTERNAL_TABLE to upload the the data into my internal table.The data is populating in the internal table.
    Now i have problem tat how to populate this excel sheet data to the Bdc table control.
    Can nybody help me out.\[removed by moderator\]
    Thanks,
    Swapna.
    Edited by: Jan Stallkamp on Jul 25, 2008 10:57 AM

    after fetching data from EXCEL sheet, each column data (in excel sheet) will be uploaded to individual record into your internal table along with row number and column number, loop through that internal table and collect all your excel data into record format.pls refer the below code.
    data:
         i_excel    type alsmex_tabline occurs 0 with header line,
         l_row      type i value 1.
    data:
         begin of x_data occurs 0,
                kunnr     like RF02L-KUNNR,
                klimk(17) type c,
                CTLPC     like knkk-CTLPC,
          end  of x_data,
          begin of x_data1 occurs 0,
                data(106),
          end   of x_data1.
    call function 'ALSM_EXCEL_TO_INTERNAL_TABLE'
       exporting
         filename                      = p_fname
         i_begin_col                   = 1
         i_begin_row                   = 1
         i_end_col                     = no.of columns in your excel file
         i_end_row                     = no.of rows in your file
       tables
         intern                        = i_excel.
    if sy-subrc = 0.
       loop at i_excel.
         if l_row <> i_excel-row.
            append x_data.
            clear x_data.
         endif.
         case i_excel-col.
            when 1.
              x_data-kunnr = i_excel-value.
            when 2.
              x_data-klimk = i_excel-value.
            when 3.
              x_data-CTLPC = i_excel-value.
         endcase.
         l_row = i_excel-row.
         clear i_excel.
         at last.
            append x_data.
         endat.
       endloop.
    endif.
    then loop through the internal table X_DATA, pass the data to your table control like.
    tbl_control-field1(1) = x_data-field1.
    tbl_control-field2(1) = x_data-field2.
    tbl_control-fieldn(1) = x_data-fieldn.
    Regards,
    Sreeram.

  • Re bdc table control

    hi gurus ,
        can any one explain about ' P++' concept about handling of table control in bdc.
    with regards
    aru.

    Note these-->
    P- : Back
    P-- : Scroll to previous page
    P+ : Scroll to next page
    <b>P++ Scroll to last page</b>
    PL- : Scroll to first line in page
    PL-n : Scroll back n lines
    PL+ : Scroll to last line in page
    PL+n Scroll forward n lines
    PP- : Scroll back one page
    PP-n Scroll back n pages
    PP+ scroll forward one page
    PP+n : scroll forward n page
    PPn : Scroll to start of page n
    Ps- : Scroll to first column
    PS++ Scroll to last column
    regards,
    srinivas
    *reward for useful answers*

  • How to populate data in table control  .

    hi all,
    i put matnr no. in screen no. 103
    validation is done at that screen only.
    now when i want to modify dat record
    when i put matnr no. at screen 103
    so how i will get all  data of dat number to table control screen.

    Hi Darshan,
       Here is a detailed description of how to update data in table controll.
      Updating data in table control
    The ABAP language provides two mechanisms for loading the table control with data from the internal table and then storing the altered rows of the table control back to the internal table.
    Method 1: Read the internal table into the Table Control in the screenu2019s flow logic.  Used when the names of the Table Control fields are based on fields of the internal table.
    Method 2: Read the internal table into the Table Control in the module pool code. Used when the names of the Table Control fields are based on fields of the database table.
    Method 1 (table control fields = itab fields)
    In the flow logic we can read an internal table using the LOOP statement. Define the reference to the relevant able control by specifying WITH CONTROL <ctrl>
    Determine which table entry is to be read by specifying CURSOR <ctrl>-CURRENT_LINE.
    After the read operation the field contents are placed in the header line of the internal table. If the fields in the table control have the same name as the internal they will be filled automatically. Otherwise we need to write a module to transfer the internal table fields to the screen fields.
    We must reflect any changes the user makes to the fields of the table control in the internal table otherwise they will not appear when the screen is redisplayed after PBO processing, (eg, after the user presses Enter or scrolls) However, this processing should be performed only if changes have actually been made to the screen fields of the table control (hence the use of the ON REQUEST)
    PROCESS BEFORE OUTPUT.
    LOOP AT ITAB_REG WITH CONTROL TCREG
    CURSOR TCREG-CURRENT_LINE.
    ENDLOOP.
    PROCESS AFTER INPUT.
    LOOP AT ITAB_REG.
    MODULE MODIFY_ITAB_REG.
    ENDLOOP.
    MODULE MODIFY_ITAB_REG INPUT.
    MODIFY ITAB_REG INDEX TCREG-CURRENT_LINE.
    ENDMODULE.
    Method 2 (table control fields = dict. fields)
    If using a LOOP statement without an internal table in the flow logic, we must read the data in a PBO module which is called each time the loop is processed.
    Since, in this case, the system cannot determine the number of internal table entries itself, we must use the EXIT FROM STEP-LOOP statement to ensure that no blank lines are displayed in the table control if there are no more corresponding entries in the internal table.
    PROCESS BEFORE OUTPUT.
    LOOP WITH CONTROL TCREG.
    MODULE READ_ITAB_REG.
    ENDLOOP.
    PROCESS AFTER INPUT.
    LOOP WITH CONTROL TCREG.
    CHAIN.
    FIELD: ITAB_REG-REG,
    ITAB_REG-DESC.
    MODULE MODIFY_ITAB_REG
    ON CHAIN-REQUEST.
    ENDCHAIN.
    ENDLOOP.
    MODULE READ_ITAB_REG OUTPUT.
    READ TABLE ITAB_REG INDEX TCREG-CURRENT_LINE.
    IF SY-SUBRC EQ 0.
    MOVE-CORRESPONDING ITAB_REREG TO TCREG.
    ELSE.
    EXIT FROM STEP-LOOP.
    ENDIF.
    ENDMODULE.
    MODULE MODIFY_ITAB_REG INPUT.
    MOVE-CORRESPONDING TCREG TO ITAB_REG.
    MODIFY ITAB_REG INDEX
    TCREG-CURRENT_LINE.
    ENDMODULE.
    Updating the internal table
    Method 1
    PROCESS AFTER INPUT.
    LOOP AT ITAB_REG.
    CHAIN.
    FIELD: ITAB_REG-REG,
    ITAB_REG-DESC.
    MODULE MODIFY_ITAB_REG ON CHAIN-REQUEST.
    ENDCHAIN.
    ENDLOOP.
    MODULE MODIFY_ITAB_REG INPUT.
    ITAB_REG-MARK = u2018Xu2019.
    MODIFY ITAB_REG INDEX TCREG-CURRENT_LINE.
    ENDMODULE.
    Method 2
    PROCESS AFTER INPUT.
    LOOP WITH CONTROL TCREG.
    CHAIN.
    FIELD: TCREG-REG,
    TCREG-DESC.
    MODULE MODIFY_ITAB_REG ON CHAIN-REQUEST.
    ENDCHAIN.
    ENDLOOP.
    MODULE MODIFY_ITAB_REG INPUT.
    MOVE-CORRESPONDING TCREG TO ITAB_REG.
    ITAB_REG-MARK = u2018Xu2019.
    MODIFY ITAB_REG INDEX TCREG-CURRENT_LINE.
    ENDMODULE.
    Updating the database
    MODULE USER_COMMAND_100.
    CASE OK_CODE.
    WHEN u2018SAVEu2019.
    LOOP AT ITAB-REG.
    CHECK ITAB_REG-MARK = u2018Xu2019.
    MOVE-CORRESPONDING ITAB_REG TO TCREG.
    UPDATE TCREG.
    ENDLOOP.
    WHEN u2026
    u2026
    ENDCASE.
    ENDMODULE.
    Hope this will solve your problem.
    Regards,
    Pavan.
    Edited by: PAVAN CHANDRASEKHAR GANTI on Aug 3, 2009 12:48 PM

  • Bdc table control.

    Dear forums friends,
    i have a problem in bdc table control.I send my report below,
    please check it and tell me what is the problem,why this report not excute.
    please tell me quickly.
    regard
    Rasmi.
    REPORT ztable_control
           NO STANDARD PAGE HEADING LINE-SIZE 255.
    *include bdcrecx1.
    *start-of-selection.
    *perform open_group.
    DATA: it_exload LIKE alsmex_tabline  OCCURS 0 WITH HEADER LINE.
    DATA : str1 TYPE string,
           var1(2) TYPE n.
           var1 = 0.
    DATA: BEGIN OF itab OCCURS 0,
          cldte(8) TYPE n,
          ocrsn(4) TYPE n,
          END OF itab.
    DATA: var3 TYPE dats,
          var6 TYPE integer.
      itab-cldte = var3.
    itab2-cldte = var3.
      itab-ocrsn = var6.
    itab2-ocrsn = var6.
    DATA: BEGIN OF itab1 OCCURS 0,
          cldte(8) TYPE n,
          ocrsn(4) TYPE n,
          pernr(1) TYPE n,
          taxcd LIKE pinct-taxcd,
          betrg(1) TYPE n,
          voudt(10) TYPE c,
          vouam(2) TYPE n,
      END OF itab1.
    DATA var(1) TYPE c.
    DATA: bdcdata LIKE bdcdata OCCURS 0 WITH HEADER LINE.
    PARAMETER: file_fi LIKE rlgrap-filename OBLIGATORY,
               w_begin TYPE   i OBLIGATORY,
               w_end   TYPE   i OBLIGATORY,
               rad1    RADIOBUTTON GROUP gp1,
               rad2    RADIOBUTTON GROUP gp1 DEFAULT 'X',
               rad3    RADIOBUTTON GROUP gp1 .
    AT SELECTION-SCREEN ON VALUE-REQUEST FOR file_fi.
      PERFORM sub_browse_file.
                         START-OF-SELECTION                      *
    START-OF-SELECTION.
      PERFORM mode_selection.
      PERFORM sub_data_load.
      PERFORM sub_data_transform.
      PERFORM sub_post_data.
                           BROWS FILE                             *
    FORM sub_browse_file .
      CALL FUNCTION 'F4_FILENAME'
        EXPORTING
          program_name  = syst-cprog
          dynpro_number = syst-dynnr
          field_name    = ' '
        IMPORTING
          file_name     = file_fi.
    ENDFORM.                                      "sub_browse_file
                             DATA LOAD                             *
    FORM sub_data_load.
      CALL FUNCTION 'ALSM_EXCEL_TO_INTERNAL_TABLE'
        EXPORTING
          filename    = file_fi
          i_begin_col = '0001'
          i_begin_row = w_begin
          i_end_col   = '0007'
          i_end_row   = w_end
        TABLES
          intern      = it_exload.
      IF sy-subrc <> 0.
        MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
                WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
      ENDIF.
    ENDFORM.                                           "sub_data_load
                          DATA TRANSFORM                           *
    FORM sub_data_transform .
      LOOP AT it_exload.
        CASE it_exload-col.
          WHEN '0001'.
            itab-cldte = it_exload-value.
            itab1-cldte = it_exload-value.
          WHEN '0002'.
            itab-ocrsn = it_exload-value.
            itab1-ocrsn = it_exload-value.
          WHEN '0003'.
            itab1-pernr = it_exload-value.
          WHEN '0004'.
            itab1-taxcd = it_exload-value.
          WHEN '0005'.
            itab1-betrg = it_exload-value.
          WHEN '0006'.
            itab1-voudt = it_exload-value.
          WHEN '0007'.
            itab1-vouam = it_exload-value.
        ENDCASE.
        AT END OF row.
          APPEND itab.
          CLEAR itab.
          APPEND itab1.
          CLEAR itab1.
          IF itab-cldte = '  '.
            itab1-cldte = '  '.
            itab-ocrsn  = '  '.
            itab1-ocrsn = '  '.
            WRITE : / var3.
            WRITE : / var6.
          ENDIF.
        ENDAT.
      ENDLOOP.
    *SORT itab by cldte.
    *delete ADJACENT DUPLICATES FROM itab2.
    ENDFORM.                                            "sub_data_transform
                            Form  sub_post_data                         *
    FORM sub_post_data .
      LOOP AT itab.
        PERFORM bdc_dynpro      USING 'HINCREMP' '3000'.
        PERFORM bdc_field       USING 'BDC_CURSOR'
                                      'WA_CLAIMS-VOUAM(01)'.
        PERFORM bdc_field       USING 'BDC_OKCODE'
                                      '=PROC'.
        PERFORM bdc_field       USING 'RPCCLMIN-CLDTE'
                                      itab-cldte .        "'01.02.2009'.
        PERFORM bdc_field       USING 'RPCCLMIN-OCRSN'
                                      itab-ocrsn.               " '0002'.
        LOOP AT itab1 WHERE cldte = itab1-cldte  AND ocrsn = itab-ocrsn.
          CONCATENATE 'wa_claims-pernr(' var1 ')' INTO str1.
          PERFORM bdc_field    USING str1
                                      itab1-pernr.              "'001'
          CONCATENATE 'WA_CLAIMS-TAXCD (' var1')' INTO str1.
          PERFORM bdc_field  USING  str1
                                      itab1-taxcd.                 "'SCHA'.
          CONCATENATE 'WA_CLAIMS-BETRG(' var1')' INTO str1.
          PERFORM bdc_field  USING str1
                                      itab1-betrg.              "'1'.
          CONCATENATE 'WA_CLAIMS-VOUDT(' var1 ')' INTO str1.
          PERFORM bdc_field   USING str1
                                      itab1-voudt.                    "'02.02.2009'.
          CONCATENATE 'WA_CLAIMS-VOUAM(' var1')' INTO str1.
          PERFORM bdc_field    USING str1
                                      itab1-vouam.              "'50'.
          var1 = var1 + 1.
         Endif.
        ENDLOOP.                                                "'50'.
        PERFORM bdc_dynpro      USING 'HINCREMP' '4000'.
        PERFORM bdc_field       USING 'BDC_OKCODE'
                                      '=BACK'.
        PERFORM bdc_dynpro      USING 'HINCREMP' '3000'.
        PERFORM bdc_field       USING 'BDC_CURSOR'
                                      'RPCCLMIN-CLDTE'.
        PERFORM bdc_field       USING 'BDC_OKCODE'
                                      '=BACK'.
        PERFORM bdc_field       USING 'RPCCLMIN-CLDTE'
                                     '01.02.2009'.
        PERFORM bdc_field       USING 'RPCCLMIN-OCRSN'
                                    '0002'.
        PERFORM bdc_dynpro      USING 'SAPLSPO1' '0100'.
        PERFORM bdc_field       USING 'BDC_OKCODE'
                                      '=YES'.
    *perform bdc_transaction using 'PC00_M40_REMP'.
        CALL TRANSACTION 'PC00_M40_REMP' USING bdcdata MESSAGES INTO messtab MODE var.
        "UPDATE 'S'
        "MODE var.
    Endloop.
    Endform.
                                START NEW SCREEN                               *
    FORM bdc_dynpro USING program dynpro.
      CLEAR bdcdata.
      bdcdata-program  = program.
      bdcdata-dynpro   = dynpro.
      bdcdata-dynbegin = 'X'.
      APPEND bdcdata.
    ENDFORM.                                                          "BDC_DYNPRO
                               INSERT FILE                                     *
    FORM bdc_field USING fnam fval.
      IF fval <> space.
        CLEAR bdcdata.
        bdcdata-fnam = fnam.
        bdcdata-fval = fval.
        APPEND bdcdata.
      ENDIF.
    ENDFORM.                                                          "BDC_FIELD
                                MODE-SELECTION                                 *
    FORM mode_selection .
      IF rad1 = 'X'.
        var = 'P'.
      ELSEIF rad2 = 'X'.
        var = 'E'.
      ELSEIF rad3 = 'X'.
        var = 'A'.
      ENDIF.
    ENDFORM.                                                  " mode_selecti

    Hi,
    Check this ...
    REPORT ztable_control
    NO STANDARD PAGE HEADING LINE-SIZE 255.
    *include bdcrecx1.
    *start-of-selection.
    *perform open_group.
    DATA: it_exload LIKE alsmex_tabline OCCURS 0 WITH HEADER LINE.
    DATA : str1 TYPE string,
    var1(2) TYPE n.
    var1 = 1.               " Change here and check
    DATA: BEGIN OF itab OCCURS 0,
    cldte(8) TYPE n,
    ocrsn(4) TYPE n,
    END OF itab.
    DATA: var3 TYPE dats,
    var6 TYPE integer.
    itab-cldte = var3.
    itab2-cldte = var3.
    itab-ocrsn = var6.
    itab2-ocrsn = var6.
    DATA: BEGIN OF itab1 OCCURS 0,
    cldte(8) TYPE n,
    ocrsn(4) TYPE n,
    pernr(1) TYPE n,
    taxcd LIKE pinct-taxcd,
    betrg(1) TYPE n,
    voudt(10) TYPE c,
    vouam(2) TYPE n,
    END OF itab1.
    DATA var(1) TYPE c.
    DATA: bdcdata LIKE bdcdata OCCURS 0 WITH HEADER LINE.
    PARAMETER: file_fi LIKE rlgrap-filename OBLIGATORY,
    w_begin TYPE i OBLIGATORY,
    w_end TYPE i OBLIGATORY,
    rad1 RADIOBUTTON GROUP gp1,
    rad2 RADIOBUTTON GROUP gp1 DEFAULT 'X',
    rad3 RADIOBUTTON GROUP gp1 .
    AT SELECTION-SCREEN ON VALUE-REQUEST FOR file_fi.
    PERFORM sub_browse_file.
    START-OF-SELECTION *
    START-OF-SELECTION.
    PERFORM mode_selection.
    PERFORM sub_data_load.
    PERFORM sub_data_transform.
    PERFORM sub_post_data.
    BROWS FILE *
    FORM sub_browse_file .
    CALL FUNCTION 'F4_FILENAME'
    EXPORTING
    program_name = syst-cprog
    dynpro_number = syst-dynnr
    field_name = ' '
    IMPORTING
    file_name = file_fi.
    ENDFORM. "sub_browse_file
    DATA LOAD *
    FORM sub_data_load.
    CALL FUNCTION 'ALSM_EXCEL_TO_INTERNAL_TABLE'
    EXPORTING
    filename = file_fi
    i_begin_col = '0001'
    i_begin_row = w_begin
    i_end_col = '0007'
    i_end_row = w_end
    TABLES
    intern = it_exload.
    IF sy-subrc 0.
    MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
    WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
    ENDIF.
    ENDFORM. "sub_data_load
    DATA TRANSFORM *
    FORM sub_data_transform .
    LOOP AT it_exload.
    CASE it_exload-col.
    WHEN '0001'.
    itab-cldte = it_exload-value.
    itab1-cldte = it_exload-value.
    WHEN '0002'.
    itab-ocrsn = it_exload-value.
    itab1-ocrsn = it_exload-value.
    WHEN '0003'.
    itab1-pernr = it_exload-value.
    WHEN '0004'.
    itab1-taxcd = it_exload-value.
    WHEN '0005'.
    itab1-betrg = it_exload-value.
    WHEN '0006'.
    itab1-voudt = it_exload-value.
    WHEN '0007'.
    itab1-vouam = it_exload-value.
    ENDCASE.
    AT END OF row.
    APPEND itab.
    CLEAR itab.
    APPEND itab1.
    CLEAR itab1.
    IF itab-cldte = ' '.
    itab1-cldte = ' '.
    itab-ocrsn = ' '.
    itab1-ocrsn = ' '.
    WRITE : / var3.
    WRITE : / var6.
    ENDIF.
    ENDAT.
    ENDLOOP.
    *SORT itab by cldte.
    *delete ADJACENT DUPLICATES FROM itab2.
    ENDFORM. "sub_data_transform
    Form sub_post_data *
    FORM sub_post_data .
    LOOP AT itab.
    PERFORM bdc_dynpro USING 'HINCREMP' '3000'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'WA_CLAIMS-VOUAM(01)'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=PROC'.
    PERFORM bdc_field USING 'RPCCLMIN-CLDTE'
    itab-cldte . "'01.02.2009'.
    PERFORM bdc_field USING 'RPCCLMIN-OCRSN'
    itab-ocrsn. " '0002'.
    LOOP AT itab1 WHERE cldte = itab1-cldte AND ocrsn = itab-ocrsn.
    CONCATENATE 'wa_claims-pernr(' var1 ')' INTO str1.
    PERFORM bdc_field USING str1
    itab1-pernr. "'001'
    CONCATENATE 'WA_CLAIMS-TAXCD (' var1')' INTO str1.
    PERFORM bdc_field USING str1
    itab1-taxcd. "'SCHA'.
    CONCATENATE 'WA_CLAIMS-BETRG(' var1')' INTO str1.
    PERFORM bdc_field USING str1
    itab1-betrg. "'1'.
    CONCATENATE 'WA_CLAIMS-VOUDT(' var1 ')' INTO str1.
    PERFORM bdc_field USING str1
    itab1-voudt. "'02.02.2009'.
    CONCATENATE 'WA_CLAIMS-VOUAM(' var1')' INTO str1.
    PERFORM bdc_field USING str1
    itab1-vouam. "'50'.
    var1 = var1 + 1.
    Endif.
    ENDLOOP. "'50'.
    PERFORM bdc_dynpro USING 'HINCREMP' '4000'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=BACK'.
    PERFORM bdc_dynpro USING 'HINCREMP' '3000'.
    PERFORM bdc_field USING 'BDC_CURSOR'
    'RPCCLMIN-CLDTE'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=BACK'.
    PERFORM bdc_field USING 'RPCCLMIN-CLDTE'
    '01.02.2009'.
    PERFORM bdc_field USING 'RPCCLMIN-OCRSN'
    '0002'.
    PERFORM bdc_dynpro USING 'SAPLSPO1' '0100'.
    PERFORM bdc_field USING 'BDC_OKCODE'
    '=YES'.
    *perform bdc_transaction using 'PC00_M40_REMP'.
    CALL TRANSACTION 'PC00_M40_REMP' USING bdcdata MESSAGES INTO messtab MODE var.
    "UPDATE 'S'
    "MODE var.
    Endloop.
    Endform.

  • How to insert data into table control

    hi experts,,
           i have inserted data into data base table through table control .
    now i want to insert data into table control through database table.
      how to delete data from table control for selected row

    Hi
    go through this link.
    http://www.****************/Tutorials/ABAP/TableControl/Demo.htm

  • How to bring cursor in Table control??

    Hi to all
    How to bring cursor in Table control when entering into screen
    can anyone tell me??? pls explain with example..
    thanks
    senthil

    Hi,
    Check the below code
    data l_tc_name             like feld-name.
    data l_tc_field_name       like feld-name.
    get actual tc and column                            
      get cursor field l_tc_field_name
                 area  l_tc_name.
    Regards,
    Vind

Maybe you are looking for

  • Attempts to load library (2K songs) so slow that ipod locks up

    I have a new 5th gen ipod that I can't get my meager library onto. It's very slow, e.g., 10-30 seconds/song, will run like that for about 90 minutes, load maybe 500 songs, and then the ipod says cannot read or write to disk. Tried phone support, they

  • MB129LL/B Composite AV Cable with my new iPod Touch 32GB to my Samsung TV

    I bought a new Samsung T240HD 24" LCD HD Monitor TV and when I hook my iPod Touch to it with a genuine Apple MB129LL/B Composite AV Cable, the picture is not very good on my tv, matter of fact, it's not even in color. Does anyone have any suggestions

  • How to change data in an inbound delivery

    Hi, I want to change the following data in an Inbound delivery: Challan No (LIKP-LIFEX, LIKP-VERUR) Date (LIKP-LFDAT, LIKP-ERDAT) Quantity (LFIMG) I have gone through the thread how to change delivery date (LFDAT) in a inbound delivery But still, it

  • Pass the REPORT_FILENAME parameter to Report,

    i think i know the problem, but i dont know how to solve it, so plz need your help guys :) the REPORT_FILENAME is to long, when i call the report using the orignal path which is D:\PISYS_10g\Eng\Reports\PI\Annually 2 years Reports\Financial\FI07_All_

  • Function module not showing my itab

    hi am working on smartforms  in se38 i declared an internal table it_regup after decalrations and select statements i went to smart forms i looped there and am displaying i called tht function moudule after calling SSF_FUNCTION_MODULE_NAME and in the