martes, 8 de noviembre de 2011

Microsoft Bootvis

Nos sirve para optimizar el boteo de windows cuando tarda mucho en cargar el logo de windows o al entrar al sistema, correrlo seleccionar trace boot + drivers, se reinicia
luego de esto damos optimizar, se reinicia y listo.

viernes, 4 de noviembre de 2011

ZSDNETPRO

REPORT SDNETPR0.
*======================================================================*
* Tabellen *
*======================================================================*
TABLES : VBCO7.
TABLES : VBRP.
TABLES : MVKE.
TABLES : TVKO.
tables : TVTW.
TABLES : T001W.
TABLES : TSPA.
TABLES : TVFK.
TABLES : TVAK.
TABLES : TVAP.
TABLES : KNVV.
TABLES : KNA1.
TABLES : VBAK.
TABLES : TVTA.
*======================================================================*
* Includes *
*======================================================================*
INCLUDE ZRVREUSE_GLOBAL_DATA.
*INCLUDE RVREUSE_GLOBAL_DATA.
INCLUDE ZRVREUSE_LOCAL_DATA.
*INCLUDE RVREUSE_LOCAL_DATA.
INCLUDE ZRVREUSE_FORMS.
*INCLUDE RVREUSE_FORMS.
*======================================================================*
* Interne Strukturen *
*======================================================================*
DATA : BEGIN OF LT_MVKE OCCURS 1000.
DATA : MATNR LIKE MVKE-MATNR.
DATA : END OF LT_MVKE.
DATA: LT_KOMFKGN LIKE KOMFKGN OCCURS 1000 WITH HEADER LINE.
DATA : LT_KOMFKKO LIKE KOMV OCCURS 1000 WITH HEADER LINE.
DATA : LT_T683S LIKE T683S OCCURS 1000 WITH HEADER LINE.
DATA : LD_VBSK LIKE VBSK.
DATA : LT_KOMFK LIKE KOMFK OCCURS 1.
DATA : LT_KOMV LIKE KOMV OCCURS 1000 WITH HEADER LINE.
DATA : LT_THEAD LIKE THEADVB OCCURS 1000.
DATA : LT_VBFS LIKE VBFS OCCURS 1000 WITH HEADER LINE.
DATA : LT_VBPA LIKE VBPAVB OCCURS 1000.
DATA : LT_VBRK LIKE VBRKVB OCCURS 10 WITH HEADER LINE.
DATA : LT_VBRP LIKE VBRPVB OCCURS 1000 WITH HEADER LINE.
DATA : LT_VBSS LIKE VBSS OCCURS 10.
DATA : ADDRESS LIKE KNA1.
DATA : BEGIN OF LT_NETPR OCCURS 10.
INCLUDE STRUCTURE VBRPVB.
DATA : WAERK LIKE VBRK-WAERK,
END OF LT_NETPR.
DATA : TRVOG TYPE C,
LF_KVORG LIKE KOMK-KVORG.
DATA : LD_VTWEG LIKE VBCO7-VTWEG.
data : ld_use_control like rvsel-xfeld value 'X'.
*======================================================================*
* Selektionsdynpro 1000 *
*======================================================================*
*Block : Organisationsdaten--------------------------------------------*
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK ORGAN WITH FRAME TITLE TEXT-A01.
PARAMETERS: P_VKORG LIKE VBCO7-VKORG OBLIGATORY.
PARAMETERS: P_VTWEG LIKE VBCO7-VTWEG OBLIGATORY.
PARAMETERS: P_SPART LIKE VBCO7-SPART OBLIGATORY.
SELECTION-SCREEN END OF BLOCK ORGAN.
*Block : Kundendaten---------------------------------------------------*
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK KUNDE WITH FRAME TITLE TEXT-A02.
PARAMETERS: P_KUNNR LIKE VBCO7-KUNNR OBLIGATORY.
SELECTION-SCREEN END OF BLOCK KUNDE.
*Block : Kundendaten---------------------------------------------------*
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK MATER WITH FRAME TITLE TEXT-A03.
PARAMETERS: P_WERKS LIKE VBRP-WERKS OBLIGATORY.
*SELECT-OPTIONS:
PARAMETERS S_MATNR LIKE VBRP-MATNR.
SELECTION-SCREEN END OF BLOCK MATER.
*Block : Vorgabedaten--------------------------------------------------*
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN BEGIN OF BLOCK DATUM WITH FRAME TITLE TEXT-A04.
SELECTION-SCREEN BEGIN OF LINE.
SELECTION-SCREEN COMMENT 1(20) TEXT-S05 FOR FIELD P_FKDAT.
SELECTION-SCREEN POSITION POS_LOW.
PARAMETERS: P_FKDAT LIKE VBRp-prsdt OBLIGATORY DEFAULT SY-DATUM.
SELECTION-SCREEN POSITION 50.
PARAMETERS: P_PSIMU TYPE PSIMU DEFAULT ' '.
SELECTION-SCREEN COMMENT 53(20) TEXT-S06 FOR FIELD P_PSIMU.
SELECTION-SCREEN END OF LINE.
PARAMETERS: P_FKARA LIKE VBAK-FKARA OBLIGATORY DEFAULT 'FX' .
PARAMETERS: P_AUART LIKE VBAK-AUART OBLIGATORY DEFAULT 'TA' .
PARAMETERS: P_PSTYV LIKE VBAP-PSTYV OBLIGATORY DEFAULT 'TAN' .
SELECTION-SCREEN END OF BLOCK DATUM.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN OUTPUT (PBO-Zeitpunkt) *
*======================================================================*
*AT SELECTION-SCREEN OUTPUT.
*======================================================================*
AT SELECTION-SCREEN OUTPUT.
DATA EXCLUDE LIKE RSEXFCODE OCCURS 0 WITH HEADER LINE.
IF SY-DYNNR = 1000.
CALL FUNCTION 'RS_SET_SELSCREEN_STATUS'
EXPORTING
P_STATUS = 'SELK'
TABLES
P_EXCLUDE = EXCLUDE
EXCEPTIONS
OTHERS = 1.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_VKORG *
*======================================================================*
AT SELECTION-SCREEN ON P_VKORG.
IF SY-DYNNR = 1000.
IF NOT P_VKORG IS INITIAL.
SELECT SINGLE * FROM TVKO WHERE VKORG = P_VKORG.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_VKORG SPACE SPACE 'TVKO'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_VTWEG *
*======================================================================*
AT SELECTION-SCREEN ON P_VTWEG.
IF SY-DYNNR = 1000.
IF NOT P_VTWEG IS INITIAL.
SELECT SINGLE * FROM TVTW WHERE VTWEG = P_VTWEG.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_VTWEG SPACE SPACE 'TVTW'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_SPART *
*======================================================================*
AT SELECTION-SCREEN ON P_SPART.
IF SY-DYNNR = 1000.
IF NOT P_SPART IS INITIAL.
SELECT SINGLE * FROM TSPA WHERE SPART = P_SPART.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_SPART SPACE SPACE 'TSPA'.
ENDIF.
ENDIF.
ENDIF.

*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_KUNNR *
*======================================================================*
AT SELECTION-SCREEN ON P_KUNNR.
IF SY-DYNNR = 1000.
IF NOT P_KUNNR IS INITIAL.
CALL FUNCTION 'VIEW_KNA1'
EXPORTING
KUNDE = P_KUNNR
IMPORTING
ANSCHRIFT = ADDRESS
EXCEPTIONS
NO_KNA1 = 1
OTHERS = 2.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_KUNNR SPACE SPACE 'KNA1'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_WERKS *
*======================================================================*
AT SELECTION-SCREEN ON P_WERKS.
IF SY-DYNNR = 1000.
IF NOT P_WERKS IS INITIAL.
SELECT SINGLE * FROM T001W WHERE WERKS = P_WERKS.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_WERKS SPACE SPACE 'T001W'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_FKARA *
*======================================================================*
AT SELECTION-SCREEN ON P_FKARA.
IF SY-DYNNR = 1000.
IF NOT P_FKARA IS INITIAL.
SELECT SINGLE * FROM TVFK WHERE FKART = P_FKARA.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_FKARA SPACE SPACE 'TVFK'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_AUART *
*======================================================================*
AT SELECTION-SCREEN ON P_AUART.
IF SY-DYNNR = 1000.
IF NOT P_AUART IS INITIAL.
SELECT SINGLE * FROM TVAK WHERE AUArt = P_AUART.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_AUART SPACE SPACE 'TVAK'.
ENDIF.
ENDIF.
ENDIF.
*======================================================================*
* Ereignis : AT SELECTION-SCREEN ON (PAI-Zeitpunkt) *
* für das Feld P_PSTYV *
*======================================================================*
AT SELECTION-SCREEN ON P_PSTYV.
IF SY-DYNNR = 1000.
IF NOT P_PSTYV IS INITIAL.
SELECT SINGLE * FROM TVAP WHERE PSTYV = P_PSTYV.
IF NOT SY-SUBRC IS INITIAL.
MESSAGE e058(00) WITH P_PSTYV SPACE SPACE 'TVAP'.
ENDIF.
ENDIF.
ENDIF.

*======================================================================*
* Ereignis : AT SELECTION-SCREEN (PAI-Zeitpunkt) *
* letztes PAI-Ereignis *
*======================================================================*
AT SELECTION-SCREEN.
* daten selektieren
IF SY-UCOMM = 'SPAL'.
IF GS_SD_ALV-VARIANT IS INITIAL.
PERFORM REUSE_ALV_VARIANT_FILL USING SY-REPID
TRVOG
SPACE
SY-UNAME
GS_SD_ALV-VARIANT.
ENDIF.
* PERFORM ALV_VARIANT_DISPLAY USING 'X'.
DATA: LV_VIEWNAME LIKE DD02L-TABNAME.
LV_VIEWNAME = 'LT_NETPR'.
GS_SD_ALV-VARIANT-REPORT = 'SDNETPR0'.
PERFORM REUSE_ALV_FIELDCATALOG_MERGE USING GS_SD_ALV-FIELDCAT[]
LV_VIEWNAME
SPACE
SPACE.
CALL FUNCTION 'REUSE_ALV_VARIANT_SELECT'
EXPORTING
I_DIALOG = 'X'
I_USER_SPECIFIC = 'A'
I_DEFAULT = SPACE
IT_DEFAULT_FIELDCAT = GS_SD_ALV-FIELDCAT[]
I_LAYOUT = GS_SD_ALV-LAYOUT
IMPORTING
ET_FIELDCAT = GS_SD_ALV-FIELDCAT[]
ET_SORT = GS_SD_ALV-SORT[]
ET_FILTER = GS_SD_ALV-FILTER[]
CHANGING
CS_VARIANT = GS_SD_ALV-VARIANT
EXCEPTIONS
WRONG_INPUT = 1
FC_NOT_COMPLETE = 2
NOT_FOUND = 3
PROGRAM_ERROR = 4
OTHERS = 5.
SET SCREEN SY-DYNNR.
LEAVE SCREEN.
ENDIF.
*======================================================================*
* Ereignis : START-OF-SELECTION (PAI-Zeitpunkt) *
* *
*======================================================================*
START-OF-SELECTION.
* daten selektieren
IF GS_SD_ALV-VARIANT IS INITIAL.
GS_SD_ALV-VARIANT-REPORT = 'SDNETPR0'.
PERFORM REUSE_ALV_VARIANT_DEFAULT
USING GS_SD_ALV.
ENDIF.
SELECT SINGLE * FROM TVTA WHERE VKORG = P_VKORG
AND VTWEG = P_VTWEG
AND SPART = P_SPART.
LD_VTWEG = TVTA-VTWKU.

SELECT MATNR
INTO CORRESPONDING FIELDS OF TABLE LT_MVKE
FROM MVKE
WHERE MATNR EQ S_MATNR AND
VKORG EQ P_VKORG AND
VTWEG EQ LD_VTWEG.
CLEAR LT_KOMFKGN.
LT_KOMFKGN-MANDT = SY-MANDT.
LT_KOMFKGN-AUART = P_AUART.
LT_KOMFKGN-VKORG = P_VKORG.
LT_KOMFKGN-VTWEG = P_VTWEG.
LT_KOMFKGN-SPART = P_SPART.
LT_KOMFKGN-FKDAT = P_FKDAT.
LT_KOMFKGN-KUNAG = P_KUNNR.
LT_KOMFKGN-PSTYV = P_PSTYV.
LT_KOMFKGN-KWMENG = 1.
LT_KOMFKGN-WERKS = P_WERKS.
LT_KOMFKGN-VGBEL = SY-UZEIT.
LT_KOMFKGN-VGBEL+6(4) = '9999'.
LT_KOMFKGN-FKARA = P_FKARA.
LT_KOMFKGN-TAXM1 = '1'.
LT_KOMFKGN-TAXK1 = '1'.


SELECT SINGLE * FROM TVFK WHERE FKART = 'FX'.

LOOP AT LT_MVKE.
LT_KOMFKGN-MATNR = LT_MVKE-MATNR.

* prepare material number
if not lt_komfkgn-matnr is initial.
call function 'CONVERSION_EXIT_MATN1_OUTPUT'
EXPORTING
input = lt_komfkgn-matnr
IMPORTING
output = lt_komfkgn-matnr.
endif.

LT_KOMFKGN-VGPOS = LT_KOMFKGN-VGPOS + 1.
APPEND LT_KOMFKGN.
ENDLOOP.

IF NOT P_PSIMU IS INITIAL.
LF_KVORG = '08'.
ENDIF.

CALL FUNCTION 'GN_INVOICE_CREATE'
EXPORTING
VBSK_I = LD_VBSK
ID_KVORG = LF_KVORG
id_no_dialog = 'X'
invoice_date = p_fkdat
pricing_date = p_fkdat
IMPORTING
VBSK_E = LD_VBSK
TABLES
XKOMFK = LT_KOMFK
XKOMFKGN = LT_KOMFKGN
XKOMFKKO = LT_KOMFKKO
XKOMV = LT_KOMV
XTHEAD = LT_THEAD
XVBFS = LT_VBFS
XVBPA = LT_VBPA
XVBRK = LT_VBRK
XVBRP = LT_VBRP
XVBSS = LT_VBSS
EXCEPTIONS
OTHERS = 1.

*======================================================================*
* Ereignis : END-OF-SELECTION (PAI-Zeitpunkt) *
* *
*======================================================================*
END-OF-SELECTION.
DATA : PT_FIELDCAT TYPE SLIS_T_FIELDCAT_ALV.
DATA : PS_LAYOUT TYPE SLIS_LAYOUT_ALV.

LT_NETPR[] = LT_VBRP[].
LT_NETPR-WAERK = LT_VBRK-WAERK.
MODIFY LT_NETPR TRANSPORTING WAERK WHERE WAERK EQ SPACE.
*FJCH MANDAMOS LA INFORMACION A MEMORIA
DATA LINEAS LIKE SY-TABIX.
DATA PN LIKE LT_NETPR-NETPR.
DATA PB LIKE LT_NETPR-NETPR.
* BREAK-POINT.
DESCRIBE TABLE LT_NETPR LINES LINEAS.
IF LINEAS > 0.
READ TABLE LT_NETPR INDEX 1.
EXPORT PB FROM LT_NETPR-NETPR TO MEMORY ID 'PB'.
* LOOP AT LT_KOMV WHERE KWERT_K < 0.
* LT_NETPR-NETPR = LT_NETPR-NETPR + LT_KOMV-KWERT_K.
* ENDLOOP.
DATA SUMA LIKE LT_KOMV-KBETR.
LOOP AT LT_KOMV WHERE WAERS = '' and KAWRT <> '0' AND KBETR < 0 .
SUMA = SUMA + ( LT_KOMV-KBETR * -1 ).
ENDLOOP.
SUMA = SUMA / 1000.
SUMA = 1 - SUMA.

LT_NETPR-NETPR = LT_NETPR-NETPR * SUMA.
EXPORT PN FROM LT_NETPR-NETPR TO MEMORY ID 'PN'.
ELSE.
LT_NETPR-NETPR = 0.
EXPORT PB FROM LT_NETPR-NETPR TO MEMORY ID 'PB'.
EXPORT PN FROM LT_NETPR-NETPR TO MEMORY ID 'PN'.
ENDIF.


* CALL FUNCTION 'REUSE_ALV_FIELDCATALOG_MERGE'
* EXPORTING
* I_PROGRAM_NAME = 'SDNETPR0'
* I_INTERNAL_TABNAME = 'LT_NETPR'
* I_INCLNAME = 'SDNETPR0'
* CHANGING
* CT_FIELDCAT = PT_FIELDCAT
* EXCEPTIONS
* INCONSISTENT_INTERFACE = 1
* PROGRAM_ERROR = 2
* OTHERS = 3.
*
* PS_LAYOUT-COLWIDTH_OPTIMIZE = 'X'.
* PS_LAYOUT-DETAIL_POPUP = 'X'.
* PS_LAYOUT-NO_KEYFIX = 'X'.
* PS_LAYOUT-KEY_HOTSPOT = 'X'.
*
* data : ld_function(30).
* if ld_use_control is initial.
* ld_function = 'REUSE_ALV_LIST_DISPLAY'.
* else.
* ld_function = 'REUSE_ALV_GRID_DISPLAY'.
* endif.
* CALL FUNCTION ld_function
* EXPORTING
* I_CALLBACK_PROGRAM = 'SDNETPR0'
* I_CALLBACK_PF_STATUS_SET = 'NETPR_PF_STATUS_SET'
* I_CALLBACK_USER_COMMAND = 'NETPR_USER_COMMAND'
* IS_LAYOUT = PS_LAYOUT
* IT_FIELDCAT = PT_FIELDCAT
* I_DEFAULT = 'X'
* I_SAVE = 'A'
* IS_VARIANT = GS_SD_ALV-VARIANT
* TABLES
* T_OUTTAB = LT_NETPR
* EXCEPTIONS
* PROGRAM_ERROR = 1
* OTHERS = 2.
*
**---------------------------------------------------------------------*
** FORM NETPR_PF_STATUS_SET *
**---------------------------------------------------------------------*
** ........ *
**---------------------------------------------------------------------*
** --> RT_EXTAB *
**---------------------------------------------------------------------*
*FORM NETPR_PF_STATUS_SET USING RT_EXTAB TYPE SLIS_T_EXTAB.
* DATA: LT_EXTAB TYPE SLIS_T_EXTAB.
* DATA: BEGIN OF EXCTAB OCCURS 1,
* OKCOD(4) TYPE C,
* END OF EXCTAB.
*
* REFRESH EXCTAB.
*
* APPEND LINES OF EXCTAB TO LT_EXTAB.
* APPEND LINES OF RT_EXTAB TO LT_EXTAB.
*
* SET PF-STATUS 'NETPR_ALV' EXCLUDING LT_EXTAB.
*
*ENDFORM.
*
**---------------------------------------------------------------------*
** FORM NETPR_USER_COMMAND *
**---------------------------------------------------------------------*
** ........ *
**---------------------------------------------------------------------*
** --> R_UCOMM *
** --> RS_SELFIELD *
**---------------------------------------------------------------------*
*FORM NETPR_USER_COMMAND USING R_UCOMM LIKE SY-UCOMM
* RS_SELFIELD TYPE SLIS_SELFIELD.
*
* IF R_UCOMM = 'EPRO'.
* READ TABLE LT_VBFS INDEX 1.
* IF SY-SUBRC IS INITIAL.
* CALL FUNCTION 'VBFS_TREE_LIST_DISPLAY'
** EXPORTING
** I_VBFS_CALLBACK_PROGRAM =
** I_VBFS_CALLBACK_USER_COMMAND =
** I_VBFS_CALLBACK_GUI_STATUS =
* TABLES
* I_VBFS = LT_VBFS
* EXCEPTIONS
* OTHERS = 1.
* ELSE.
* MESSAGE E008(VR).
* ENDIF.
* ENDIF.
*
*
*
*
*
*
*
*ENDFORM.

Calcular precio neto con descuentos

************************************************************************
*DESCRIPCION
************************************************************************
*Reporte que genera un listado con el precio neto de cada material
*considerando los descuentos.
*Los parametros del programa son cliente y material y un check para
*bajar o no el archivo de texto y ruta del servidor donde se guardara
*el archivo txt
*FJCH OCT.2011
************************************************************************
REPORT ZPREFIN .
TABLES: KNA1,LIPS,MAKT,MARA,KNVV,MARC.
INCLUDE ZALV.

************************************************************************
*VARIABLES
************************************************************************
DATA g_repid like sy-repid.
data A(10).
data porc type p.
DATA LINEAS LIKE SY-TABIX.
DATA LINEAS2 LIKE SY-TABIX.

************************************************************************
*TABLAS INTERNAS
************************************************************************
*TABLA DE SALIDA DEL AVL
DATA: BEGIN OF IOUT OCCURS 0,
WERKS like KNVV-VWERK,
VKORG LIKE KNVV-VKORG,
VTWEG LIKE KNVV-VTWEG,
SPART LIKE KNVV-SPART,
BZIRK LIKE KNVV-BZIRK,
KUNNR LIKE KNA1-KUNNR,
NAME1 LIKE KNA1-NAME1,
MATNR LIKE LIPS-MATNR,
MAKTX LIKE MAKT-MAKTX,
NETPR2 LIKE LIPS-NETPR,
NETPR LIKE LIPS-NETPR
.
DATA END OF IOUT.
*TABLA CON LA INFORMACION DE LOS MATERIALES.
DATA IMAKT LIKE MAKT OCCURS 0 WITH HEADER LINE.
DATA BEGIN OF IMARA OCCURS 0.
INCLUDE STRUCTURE MARA.
DATA WERKS LIKE MARC-WERKS.
DATA END OF IMARA.
*TABLA CON LA INFORMACION DE LOS CLIENTES
DATA BEGIN OF IKNA1 OCCURS 0.
INCLUDE STRUCTURE KNA1.
DATA: BZIRK LIKE KNVV-BZIRK,
VWERK LIKE KNVV-VWERK,
VKORG LIKE KNVV-VKORG,
VTWEG LIKE KNVV-VTWEG,
SPART LIKE KNVV-SPART,
NETPR LIKE LIPS-NETPR,
NETPR2 LIKE LIPS-NETPR.
DATA END OF IKNA1.

************************************************************************
*PARAMETROS
************************************************************************
SELECTION-SCREEN BEGIN OF BLOCK LIST WITH FRAME TITLE TEXT-001.
SELECT-OPTIONS:
P_CLI FOR KNA1-KUNNR OBLIGATORY,
P_MATKL FOR MARA-MATKL,
P_MAT FOR LIPS-MATNR,
P_ZONA FOR KNVV-BZIRK,
P_WERKS FOR MARC-WERKS.
SELECTION-SCREEN END OF BLOCK LIST.

SELECTION-SCREEN BEGIN OF BLOCK LIST2 WITH FRAME TITLE TEXT-002.
PARAMETERS:
P_CHECK AS CHECKBOX,
P_PATH(128) DEFAULT
'C:\Inetpub\ftproot\comercial\PRNETO.TXT',
P_SEPARA(1) DEFAULT '|'.
SELECTION-SCREEN END OF BLOCK LIST2.

************************************************************************
*START-OF-SELECTION
************************************************************************
START-OF-SELECTION.
g_repid = sy-repid.
PERFORM TRAEINFO.
DESCRIBE TABLE IOUT LINES LINEAS.
DELETE IOUT WHERE NETPR = 0.
IF P_CHECK = 'X'.
PERFORM DOWNLOADA.
MESSAGE I368(00) WITH 'Se ha descargado archivo ' P_PATH.
ELSE.
PERFORM DESPLIEGAALV.
ENDIF.


*&---------------------------------------------------------------------*
*& Form TRAEINFO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM TRAEINFO.
DATA FECHA2 LIKE SY-DATUM.
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = 1
TEXT = 'Recolectando datos'.

FECHA2 = SY-DATUM - 30.
*SI SELECCIONA TODOS LOS CLIENTES SOLO
*TRAEMOS LOS CLIENTES QUE HAN CREADO UN PEDIDO EN EL ULTIMO MES
IF P_CLI-LOW = '*'.
SELECT KNA1~KUNNR NAME1 KNVV~VKORG KNVV~VTWEG KNVV~SPART BZIRK FROM
KNA1
JOIN KNVV ON KNVV~KUNNR = KNA1~KUNNR
JOIN VBAK ON VBAK~KUNNR = KNA1~KUNNR INTO
CORRESPONDING FIELDS OF TABLE IKNA1
WHERE KNA1~KUNNR IN P_CLI AND
BZIRK IN P_ZONA
AND ( VBAK~ERDAT >= FECHA2 AND VBAK~ERDAT <= SY-DATUM ).
ELSE.
SELECT KNA1~KUNNR NAME1 KNVV~VKORG KNVV~VTWEG KNVV~SPART BZIRK FROM
KNA1
JOIN KNVV ON KNVV~KUNNR = KNA1~KUNNR INTO
CORRESPONDING FIELDS OF TABLE IKNA1
WHERE KNA1~KUNNR IN P_CLI AND
BZIRK IN P_ZONA
.
ENDIF.
SORT IKNA1 BY KUNNR BZIRK VWERK VKORG VTWEG SPART.
DELETE ADJACENT DUPLICATES FROM IKNA1 COMPARING ALL FIELDS.

*SI SELECCIONA TODOS LOS MATERIALES TOMAMOS TODOS LOS QUE SE HAYA ECHO
*UN PEDIDO EN EL ULTIMO MES DE LO CONTRARIO LOS QUE INDIQUE EL PARAMETRO
DATA BEGIN OF MATERIALES OCCURS 0.
DATA MATNR LIKE VBAP-MATNR.
DATA END OF MATERIALES.

IF P_MAT-LOW IS INITIAL OR P_MAT-LOW = '*'.
CLEAR P_MAT. REFRESH P_MAT.
SELECT MATNR FROM VBAP INTO TABLE MATERIALES
WHERE ERDAT >= FECHA2 AND ERDAT <= SY-DATUM.
SORT MATERIALES BY MATNR.
DELETE ADJACENT DUPLICATES FROM MATERIALES COMPARING MATNR.
LOOP AT MATERIALES.
P_MAT-SIGN = 'I'.
P_MAT-OPTION = 'EQ'.
P_MAT-LOW = MATERIALES-MATNR.
APPEND P_MAT.
ENDLOOP.
ENDIF.

SELECT MARA~MATNR WERKS FROM MARA
JOIN MARC ON MARA~MATNR = MARC~MATNR
INTO CORRESPONDING FIELDS OF TABLE IMARA
WHERE MARA~MATNR IN P_MAT
AND WERKS IN P_WERKS
AND MTART = 'FERT'
AND MATKL IN P_MATKL.
IF SY-SUBRC = 0.
DELETE ADJACENT DUPLICATES FROM IMARA COMPARING MATNR.
ENDIF.
IF SY-SUBRC = 0.
SELECT MATNR MAKTX FROM MAKT INTO CORRESPONDING FIELDS OF TABLE
IMAKT
FOR ALL ENTRIES IN IMARA
WHERE MATNR = IMARA-MATNR.
ENDIF.
*CALCULAMOS EL PRECIO NETO Y BRUTO PARA CADA CLIENTE CON CADA PRODUCTO
*DE LOS QUE SACAMOS ANTERIORMENTE
DESCRIBE TABLE IKNA1 LINES LINEAS.
DESCRIBE TABLE IKNA1 LINES LINEAS2.
DATA CLINEAS2(20).
DATA CLINEAS22(20).
MOVE LINEAS2 TO CLINEAS22.
LOOP AT IKNA1.
MOVE SY-TABIX TO CLINEAS2.
CONDENSE: CLINEAS2, CLINEAS22.
CONCATENATE CLINEAS2 '/' CLINEAS22 INTO A.
porc = sy-tabix * ( 100 / lineas ).
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = porc
TEXT = A.
LOOP AT IMARA.
PERFORM F_PRECIOF.
MOVE-CORRESPONDING IKNA1 TO IOUT.
IOUT-MATNR = IMARA-MATNR.
IOUT-WERKS = IMARA-WERKS.

READ TABLE IMAKT WITH KEY MATNR = IMARA-MATNR.
IF SY-SUBRC = 0.
IOUT-MAKTX = IMAKT-MAKTX.
ENDIF.
APPEND IOUT.
ENDLOOP.
ENDLOOP.
ENDFORM. " TRAEINFO
*&---------------------------------------------------------------------*
*& Form DESPLIEGAALV
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM DESPLIEGAALV.
PERFORM obt_descrip_campos_tabla USING g_repid 'IOUT'.
PERFORM camb_descrip_campos_tabla USING 'NETPR' 'Pr.Bruto'.
PERFORM camb_descrip_campos_tabla USING 'NETPR2' 'Pr.Neto'.
PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES IOUT USING 'IOUT' g_repid .
ENDFORM. " DESPLIEGAALV
*&---------------------------------------------------------------------*
*& Form DESPLIEGAALV
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
form set_status using rt_extab type slis_t_extab.

set pf-status 'ZSTANDARD'. "Status nuevo
set titlebar 'T001'. "Titulo

ENDFORM.
*&---------------------------------------------------------------------*
*& Form DOWNLOADA
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM DOWNLOADA.
DATA: LINEA(10000),
CNETWR(20),CNETWR2(20).
OPEN DATASET P_PATH FOR OUTPUT IN TEXT MODE.
LOOP AT IOUT.
CLEAR: LINEA,CNETWR,CNETWR2.
MOVE IOUT-NETPR TO CNETWR.
MOVE IOUT-NETPR2 TO CNETWR2.
CONDENSE: CNETWR, CNETWR2.
CONCATENATE
IOUT-WERKS P_SEPARA
IOUT-VKORG P_SEPARA
IOUT-VTWEG P_SEPARA
IOUT-SPART P_SEPARA
IOUT-BZIRK P_SEPARA
IOUT-KUNNR P_SEPARA
IOUT-NAME1 P_SEPARA
IOUT-MATNR P_SEPARA
IOUT-MAKTX P_SEPARA
CNETWR2 P_SEPARA
CNETWR P_SEPARA
INTO LINEA.
TRANSFER LINEA TO P_PATH.
ENDLOOP.
CLOSE DATASET P_PATH.
ENDFORM. " DOWNLOADA
*&---------------------------------------------------------------------*
*& Form F_PRECIOF
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_IOUT_MATNR text
* -->P_IOUT_KUNNR text
*----------------------------------------------------------------------*
FORM F_PRECIOF.
SUBMIT ZSDNETPR0
WITH P_VKORG = IKNA1-VKORG
WITH P_VTWEG = IKNA1-VTWEG
WITH P_SPART = IKNA1-SPART
WITH P_KUNNR = IKNA1-KUNNR
WITH P_WERKS = IMARA-WERKS
WITH S_MATNR = IMARA-MATNR
WITH P_FKDAT = SY-DATUM AND RETURN.
IMPORT PB TO IKNA1-NETPR FROM MEMORY ID 'PB'.
IMPORT PN TO IKNA1-NETPR2 FROM MEMORY ID 'PN'.
ENDFORM. " F_PRECIOF

Smartform

*Programa ejemplo que recolecta datos y luego los manda a un smartform por medio de *itab1

REPORT ZTESTSMART .

* Calling SMARTFORMS from your ABAP program.
* Collecting all the table data in your program, and pass once to
* SMARTFORMS
* Declare your table type in :-
* Global Settings -> Form Interface
* Global Definintions -> Global Data
* Main Window -> Table -> DATA
*
* Written by : SAP Hints and Tips on Configuration and ABAP/4
*Programming
* http://sapr3.tripod.com
*

TABLES: MKPF.

DATA: FM_NAME TYPE RS38L_FNAM.

DATA: BEGIN OF INT_MKPF OCCURS 0.
INCLUDE STRUCTURE MKPF.
DATA: END OF INT_MKPF.

data itab1 like int_mkpf occurs 0 with header line.

SELECT-OPTIONS S_MBLNR FOR MKPF-MBLNR MEMORY ID 001.

select * from mkpf into corresponding fields of table int_mkpf up to 10
rows.

* At the end of your program.
* Passing data to SMARTFORMS

*call function 'SSF_FUNCTION_MODULE_NAME'
* exporting
* formname = 'ZCON_BANCARIA'
* VARIANT = ' '
* DIRECT_CALL = ' '
* IMPORTING
* FM_NAME = FM_NAME
* EXCEPTIONS
* NO_FORM = 1
* NO_FUNCTION_MODULE = 2
* OTHERS = 3.
*
*if sy-subrc <> 0.
* WRITE: / 'ERROR 1'.
* MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
* WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
*endif.
itab1[] = int_mkpf[].
call function '/1BCDWB/SF00000011'
*call function FM_NAME
* EXPORTING
* ARCHIVE_INDEX =
* ARCHIVE_INDEX_TAB =
* ARCHIVE_PARAMETERS =
* CONTROL_PARAMETERS =
* MAIL_APPL_OBJ =
* MAIL_RECIPIENT =
* MAIL_SENDER =
* OUTPUT_OPTIONS =
* USER_SETTINGS = 'X'
* IMPORTING
* DOCUMENT_OUTPUT_INFO =
* JOB_OUTPUT_INFO =
* JOB_OUTPUT_OPTIONS =
TABLES
itab1 = itab1
EXCEPTIONS
FORMATTING_ERROR = 1
INTERNAL_ERROR = 2
SEND_ERROR = 3
USER_CANCELED = 4
OTHERS = 5.

if sy-subrc <> 0.
MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
endif.

miércoles, 2 de noviembre de 2011

Cargar archivo UNIX

*Los archivos de unix tienen diferente separador de lineas, si cargas un archivo por *medio de GUI_UPLOAD o alguna funcion parecida al cargarla te pondra todo el texto en *una sola linea, para evitar esto podemos pasar el archivo cargado al servidor y luego *leerlo desde ahi.

REPORT ZEX_READFILE_FROMDIR LINE-SIZE 1000
.


Data: d_filename like IBIPPARMS-PATH,
d_file type string.

data : begin of itab occurs 0,
values(10000),
end of itab.

* The following function module calls the File/Path Selector Dialog Box

CALL FUNCTION 'F4_FILENAME'
EXPORTING
PROGRAM_NAME = SYST-CPROG
DYNPRO_NUMBER = SYST-DYNNR
FIELD_NAME = ' '
IMPORTING
FILE_NAME = d_filename.

d_file = d_filename.

* The following function module uploads the file into the internal table

CALL FUNCTION 'GUI_UPLOAD'
EXPORTING
FILENAME = d_file
FILETYPE = 'BIN'
HAS_FIELD_SEPARATOR = ' '
HEADER_LENGTH = 0
READ_BY_LINE = 'X'
DAT_MODE = ' '
* IMPORTING
* FILELENGTH =
* HEADER =
TABLES
DATA_TAB = itab
EXCEPTIONS
FILE_OPEN_ERROR = 1
FILE_READ_ERROR = 2
NO_BATCH = 3
GUI_REFUSE_FILETRANSFER = 4
INVALID_TYPE = 5
NO_AUTHORITY = 6
UNKNOWN_ERROR = 7
BAD_DATA_FORMAT = 8
HEADER_NOT_ALLOWED = 9
SEPARATOR_NOT_ALLOWED = 10
HEADER_TOO_LONG = 11
UNKNOWN_DP_ERROR = 12
ACCESS_DENIED = 13
DP_OUT_OF_MEMORY = 14
DISK_FULL = 15
DP_TIMEOUT = 16
OTHERS = 17.


IF SY-SUBRC = 0.

ENDIF.

* Output the internal Table


DATA P_PATH(128) value
'C:\'.

DATA: LINEA(1000),
CNETWR(20).
OPEN DATASET P_PATH FOR OUTPUT IN TEXT MODE.
loop at itab.
TRANSFER itab-values TO P_PATH.
ENDLOOP.
CLOSE DATASET P_PATH.

OPEN DATASET P_PATH FOR INPUT IN TEXT MODE.
loop at itab.
TRANSFER itab-values TO P_PATH.
ENDLOOP.
CLOSE DATASET P_PATH.

clear itab.
refresh itab.

open dataset P_PATH for input in text mode.
if sy-subrc is initial.
do.
read dataset P_PATH into itab.
if not sy-subrc is initial.
exit.
endif.
append itab.
enddo.
endif.
close dataset P_PATH.



loop at itab.
Write:/ ITAB.
endloop.
data text(100).
text =
'Este archivo se crea cada que se ejecuta el Programa'.
append itab.


OPEN DATASET P_PATH FOR OUTPUT IN TEXT MODE.
TRANSFER text TO P_PATH.
CLOSE DATASET P_PATH.

miércoles, 19 de octubre de 2011

ABAP Muestra en alv el contenido de una carpeta

report zpruebasf .
*-Variable para pasarle la ruta a la función
parameter p_file type localfile.
DATA: lv_name TYPE salfile-longname.
data it_filedir type filedir occurs 0 with header line.
data: begin of i_out occurs 0,
check(1),
line(255),
procesado(9).
data end of i_out.
data g_repid like sy-repid.
include zalv." el include para alv tambien esta en este blog
*->Levanto la lista de directorios


start-of-selection.
g_repid = sy-repid.

lv_name = p_file.
CALL FUNCTION 'RZL_READ_DIR_LOCAL'
EXPORTING
name = lv_name
TABLES
file_tbl = it_filedir
EXCEPTIONS
argument_error = 1
not_found = 2
OTHERS = 3.
IF sy-subrc <> 0.
MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
ENDIF.

loop at it_filedir.
move it_filedir to i_out-line.
append i_out.
endloop.

PERFORM obt_descrip_campos_tabla USING g_repid 'I_OUT'.
layout-box_fieldname = 'CHECK'.
layout-box_tabname = 'I_OUT'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_OUT USING 'I_OUT'
g_repid .

miércoles, 12 de octubre de 2011

Programa genera demanda

************************************************************************
*Programa que crea la demanda de materianles por medio de la MD61
*leyendo un archivo desde el servidor
************************************************************************


REPORT ZDEMANDA .


************************************************************************
* *VARIABLES
************************************************************************
data A(10).
data porc type i.
data archivo type localfile.
data tamano(10).
data g_repid like sy-repid.
data: lv_name TYPE salfile-longname.
data it_filedir type filedir occurs 0 with header line.
include zalv.
data OPENG(1).
data CSYSUBRC like Sy-subrc.

************************************************************************
* *TABLAS INTERNAS
************************************************************************
data i_zdemanda like zdemanda occurs 0 with header line.
*Tabla interna para alv
data: begin of i_out occurs 0,
check(1),
line(255).
data end of i_out.
*Tabla interna para cargar cada archivo
DATA: BEGIN OF i_table OCCURS 0,
l_line(1000) type c.
DATA: END OF i_table.
*Tabla interna para separar cada linea de el archivo
DATA: BEGIN OF i_split OCCURS 0,
line(1000) type c.
DATA: END OF i_split.
*Tablas para hacer el batch input
DATA: BDC_TAB LIKE STANDARD TABLE OF BDCDATA WITH HEADER LINE,
ERR_BI LIKE STANDARD TABLE OF BDCMSGCOLL WITH HEADER LINE.

************************************************************************
* *PARAMETROS DE SELECCION
************************************************************************
SELECTION-SCREEN BEGIN OF BLOCK block1 WITH FRAME title text-001.
PARAMETERS:
p_file TYPE rlgrap-filename OBLIGATORY DEFAULT
'C:\Inetpub\ftproot\operaciones\mrp\',
Mode(1) default 'N',
SESSION(1) default 'X',
p_separa(1) default ',',
pro as checkbox.

SELECTION-SCREEN END OF BLOCK block1.




************************************************************************
* *START-OF-SELECTION
************************************************************************
************************************************************************
START-OF-SELECTION.
g_repid = sy-repid.
lv_name = p_file.
*Traemos el contenido del directorio
CALL FUNCTION 'RZL_READ_DIR_LOCAL'
EXPORTING
name = lv_name
TABLES
file_tbl = it_filedir
EXCEPTIONS
argument_error = 1
not_found = 2
OTHERS = 3.
IF sy-subrc <> 0.
MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
ENDIF.
*Eliminamos las que sean directorios o de tamaño = 0
loop at it_filedir.
i_out-line = it_filedir.
if not i_out-line cs '0000000000' and i_out-line cs 'PRON'.
append i_out.
endif.
endloop.

*Eliminamos de la lista los que ya fueron procesados
if pro <> 'X'.
loop at i_out.
split i_out-line at space into archivo tamano.
condense archivo.
select * from zdemanda into table i_zdemanda
where nombre = archivo.
if sy-subrc = 0.
delete i_out.
endif.
endloop.
endif.

*Lanzamos un alv con el listado y un campo check
clear i_zdemanda.
refresh i_zdemanda.
PERFORM obt_descrip_campos_tabla USING g_repid 'I_OUT'.
layout-box_fieldname = 'CHECK'.
layout-box_tabname = 'I_OUT'.
PERFORM camb_descrip_campos_tabla USING 'LINE'
'Archivo'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_OUT USING 'I_OUT'
g_repid .


*&---------------------------------------------------------------------*
*& Form F_CARGA_FICHERO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_I_TABLE text
* -->P_P_FILE text
*----------------------------------------------------------------------*
FORM F_CARGA_FICHERO TABLES i_table STRUCTURE i_table
USING P_P_FILE.

data: v_files type string.

v_files = p_p_file.

refresh i_table.

open dataset v_files for input in text mode.
if sy-subrc is initial.
do.
read dataset v_files into i_table.
if not sy-subrc is initial.
exit.
endif.
append i_table.
enddo.
endif.
close dataset v_files.

if sy-subrc ne 0.
write: /'No se Pudo cargar el archivo ', archivo .
else.
write: /'Se ha cargado el archivo ',archivo,' correctamente'.
endif.

ENDFORM. " F_CARGA_FICHERO


*&---------------------------------------------------------------------*
*& Form f_batch_MD61
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_batch_MD61.
Data: material(20),
centro(4),
periodo(1),
cantidad(10),
MENSAJE LIKE T100-TEXT,
COPY_SYTABIX LIKE SY-TABIX,
contador like sy-tabix value 0,
fecha like SCAL-WEEK,
fecha1 LIKE SCAL-DATE,
fecha2 like SCAL-DATE,
texto(100),
texto2(100),
si(1).

clear: contador, copy_sytabix,si,centro,periodo,material.

LOOP AT I_SPLIT.
contador = contador + 1.
move sy-tabix to COPY_SYTABIX.
if si is initial and contador > 3.
si = 'X'.
else.
si = ''.
endif.
if COPY_SYTABIX = 1.
centro = i_split-line.
endif.
if COPY_SYTABIX = 2.
periodo = i_split-line.
endif.
if COPY_SYTABIX = 3.
material = i_split-line.
endif.

IF COPY_SYTABIX > 3 AND SI = 'X'.
REFRESH BDC_TAB.
perform bdc_dynpro using 'SAPMM60X' '0100'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'AM60X-MATAW'
'X'.
perform bdc_field using 'AM60X-MATNR'
material.
perform bdc_field using 'AM60X-WERKS'
centro.
perform bdc_field using 'RM60X-VERSB'
'00'.
perform bdc_field using 'RM60X-ENTLU'
periodo.

*Obtenemos las fechas de acuerdo a la semana que indique el archivo

read table i_split index contador.
texto = i_split-line.
concatenate texto+3(4) texto+0(2) into texto.
move texto to fecha.
CALL FUNCTION 'WEEK_GET_FIRST_DAY'
EXPORTING
WEEK = fecha
IMPORTING
DATE = fecha1
EXCEPTIONS
WEEK_INVALID = 1
OTHERS = 2.
IF SY-SUBRC <> 0.
fecha1 = fecha.
fecha2 = fecha.
SY-SUBRC = 0.
endif.

IF SY-SUBRC = 0.
fecha2 = fecha1 + 6.
concatenate fecha1+6(2) fecha1+4(2) fecha1+0(4) into fecha1.
concatenate fecha2+6(2) fecha2+4(2) fecha2+0(4) into fecha2.
perform bdc_field using 'RM60X-DATVE'
fecha1.
perform bdc_field using 'RM60X-DATBE'
fecha2.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'=PEIN'.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'RM60E-PLNMG(01)'.
perform bdc_field using 'PBPT-VERVS'
'X'.
perform bdc_field using 'RM60E-EDATU(01)'
i_split-line.
contador = contador + 1.
read table i_split index contador.
perform bdc_field using 'RM60E-PLNMG(01)'
i_split-line.
move i_split-line to cantidad.
contador = contador - 1.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'=SICH'.
REFRESH ERR_BI.

CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = porc
TEXT = A.

CALL TRANSACTION 'MD61' USING BDC_TAB MODE MODE MESSAGES INTO ERR_BI.
CSYSUBRC = SY-SUBRC.
commit work.
condense: material,texto.


IF CSYSUBRC = 0.

concatenate
'Centro:' centro
'**Material:'material
'**Semana:' texto
'**Cantidad:' cantidad
'**sin errores' into texto.
translate texto using '* '.
WRITE:/ texto color col_positive.
ELSE.

* Adición de la transacción errónea al JD para procesarlo on-line
if OPENG is initial.
perform open_group.
OPENG = 'X'.
endif.

PERFORM BDC_INSERT.
concatenate
'Centro:' centro
'**Material:' material
'**Semana:' texto
'**Con errores' into texto.
translate texto using '* '.
WRITE: / texto color col_negative.
LOOP AT ERR_BI.
SELECT SINGLE TEXT INTO MENSAJE
FROM T100
WHERE SPRSL = 'S' AND
ARBGB = ERR_BI-MSGID AND
MSGNR = ERR_BI-MSGNR.
NEW-LINE.
WRITE AT: 1 ERR_BI-DYNAME,
15 ERR_BI-DYNUMB,
20 ERR_BI-MSGTYP,
22 ERR_BI-MSGNR,
26 MENSAJE.
ENDLOOP.
ENDIF.
ENDIF."fecha
ENDIF.">3
ENDLOOP."I_SPLIT
ENDFORM. " f_batch_MD61


*----------------------------------------------------------------------*
* create batchinput session *
* Creamos una sesion de batch para los errores *
*----------------------------------------------------------------------*

FORM OPEN_GROUP.
IF SESSION = 'X'.
CALL FUNCTION 'BDC_OPEN_GROUP'
EXPORTING
CLIENT = SY-MANDT
GROUP = 'ZDEMANDA'
KEEP = 'X'
USER = SY-UNAME.
ENDIF.
ENDFORM.

*----------------------------------------------------------------------*
* create batchinput session *
* Cerramos una sesion de batch para los errores *
*----------------------------------------------------------------------*
IF SESSION = 'X'.

CALL FUNCTION 'BDC_CLOSE_GROUP'
EXCEPTIONS
NOT_OPEN = 1
QUEUE_ERROR = 2
OTHERS = 3.
ENDIF.

*----------------------------------------------------------------------*
* Start new screen *
*----------------------------------------------------------------------*
FORM BDC_DYNPRO USING PROGRAM DYNPRO.
CLEAR BDC_TAB.
BDC_TAB-PROGRAM = PROGRAM.
BDC_TAB-DYNPRO = DYNPRO.
BDC_TAB-DYNBEGIN = 'X'.
APPEND BDC_TAB.
ENDFORM.

*----------------------------------------------------------------------*
* Insert field *
*----------------------------------------------------------------------*
FORM BDC_FIELD USING FNAM FVAL.
IF SESSION = 'X'.
CLEAR BDC_TAB.
BDC_TAB-FNAM = FNAM.
BDC_TAB-FVAL = FVAL.
APPEND BDC_TAB.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form BDC_INSERT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM BDC_INSERT.
CALL FUNCTION 'BDC_INSERT'
EXPORTING
TCODE = 'MD61'
TABLES
DYNPROTAB = BDC_TAB.
ENDFORM. " BDC_INSERT
*&---------------------------------------------------------------------*
*& Form close_group
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM close_group.
CALL FUNCTION 'BDC_CLOSE_GROUP'
EXCEPTIONS
NOT_OPEN = 1
QUEUE_ERROR = 2
OTHERS = 3.

ENDFORM. " close_group

*---------------------------------------------------------------------*
* FORM SET_STATUS *
*---------------------------------------------------------------------*

form set_status using rt_extab type slis_t_extab.

set pf-status 'ZSTANDARD'. "Status nuevo
set titlebar 'T001'. "Titulo

endform.

*&---------------------------------------------------------------------*
*& Form USER_COMMAND
*&---------------------------------------------------------------------*

FORM USER_COMMAND USING r_ucomm LIKE sy-ucomm
rs_selfield TYPE slis_selfield.

data: archivos type i, lineas type i.
data carchivos(5).
*CUANDO SE PRESIONE EL BOTON PROCESAR ARCHIVO
CASE r_ucomm.
WHEN '&PRO'. "si presiona el boton procesar
*CONTAMOS CANTIDAD DE ARCHIVOS SELECCIONADOS
loop at i_out where check = 'X'.
archivos = archivos + 1.
endloop.
move archivos to carchivos.
archivos = 0.
loop at i_out where check = 'X'.
archivos = archivos + 1.
move archivos to A.
condense: A, carchivos.
concatenate A '/' carchivos into A.
clear: archivo, tamano.
split i_out-line at space into archivo tamano.
i_zdemanda-fecha = sy-datum.
i_zdemanda-hora = sy-uzeit.
i_zdemanda-usuario = sy-uname.
i_zdemanda-nombre = archivo.
insert zdemanda from i_zdemanda.
concatenate p_file archivo into archivo.
perform f_carga_fichero tables i_table using archivo.
*Para cada linea del archivo cargado se hace una llamada a MD61
delete i_table where l_line = ''.
describe table i_table lines lineas.
loop at i_table.

split i_table at p_separa into table i_split.
perform f_batch_MD61.
skip.
porc = sy-tabix * ( 100 / lineas ).
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = PORC
TEXT = A.

endloop.
if OPENG = 'X'.
perform close_group.
skip.
WRITE: 'Los errores se pueden tratar en SM35 "ZDEMANDA", o corrija el
archivo e intente de nuevo.'
color col_total.
endif.
endloop."i_out-check = 'X'.
ENDCASE.
clear i_out.
refresh i_out.
ENDFORM.

Traspasos

report ztraspasos line-size 185.
tables: lips, likp, disvariant, mara.
*VARIABLES PARA BATCH INPUT
data v_traspaso(20).
CONSTANTS:
CODE LIKE TSTC-TCODE VALUE 'MB1B'.
DATA: BDC_TAB LIKE STANDARD TABLE OF BDCDATA WITH HEADER LINE,
ERR_BI LIKE STANDARD TABLE OF BDCMSGCOLL WITH HEADER LINE.
*VARIABLES PARA GRABAR DISPOSICION
data: gx_variant like disvariant.
data: g_variant like disvariant.
data: g_variant_save value 'U'.
data: g_variant_flag.
data: estado(10).
*TABLA INTERNA PARA LOS DATOS
data begin of i_datos occurs 0 .
DATA: EXTRN like CFPAR-EXTRN,
VBELN like LIPS-VBELN,
ERDAT like LIPS-ERDAT,
kodat like likp-kodat,
POSNR like LIPS-POSNR,
MATNR like lips-matnr,
WERKS like lips-werks,
LGORT like lips-lgort,
LFIMG like lips-lfimg,
VRKME like lips-vrkme,
NTGEW like lips-ntgew,
BRGEW like lips-brgew,
ARKTX like lips-arktx.
data end of i_datos.

*TABLA INTERNA DE LOTES
data begin of i_mchb occurs 0.

data:
VBELN like LIPS-VBELN,
POSNR like LIPS-POSNR,
MATNR like mchb-matnr,
WERKS like mchb-werks,
Lgort like mchb-lgort,
charg like mchb-charg,
clabs like mchb-clabs,
MATNR2 like mchb-matnr,
WERKS2 like mchb-werks,
Lgort2 like mchb-lgort,
charg2 like mchb-charg,
clabs2 like mchb-clabs.

data end of i_mchb.

data begin of i_mchbtemp occurs 0.

data:
VBELN like LIPS-VBELN,
POSNR like LIPS-POSNR,
MATNR like mchb-matnr,
WERKS like mchb-werks,
Lgort like mchb-lgort,
charg like mchb-charg,
clabs like mchb-clabs,
MATNR2 like mchb-matnr,
WERKS2 like mchb-werks,
Lgort2 like mchb-lgort,
charg2 like mchb-charg,
clabs2 like mchb-clabs.

data end of i_mchbtemp.


data: begin of i_likp occurs 0,
vbeln like likp-vbeln,
kodat like likp-kodat.
data end of i_likp.
*PARA ALV
type-pools: slis.
data: gt_fieldcat type slis_t_fieldcat_alv with header line,
gs_layout type slis_layout_alv,
g_repid like sy-repid.

*PARAMETROS
selection-screen begin of block list with frame title text-001.

select-options:
p_vbeln for lips-vbeln,
p_kodat for likp-kodat obligatory,
p_erdat for lips-erdat,
p_werks for lips-werks obligatory default '0030',
p_lgort for lips-lgort obligatory default '0014',
p_matnr for lips-matnr.
parameter v_todosl as checkbox.
selection-screen end of block list.

selection-screen begin of block list2 with frame title text-002.
parameter p_varia like disvariant-variant default '/STD'.
parameter modo(1) default 'A'.

selection-screen end of block list2.

include zalv.
*PARA SELECCIONAR LA VISUALIZACION
at selection-screen output.

clear g_variant.
g_variant-report = sy-repid.
g_variant-username = sy-uname.

if p_varia is initial and
g_variant_flag is initial.
perform get_default_variant_f14 using p_varia.
g_variant_flag = 'X'.
endif.

at selection-screen on value-request for p_varia.
perform variant_inputhelp_f14 using p_varia.

at user-command.
break-point.
initialization.

g_repid = sy-repid.

start-of-selection.

perform trae_datos.
PERFORM obt_descrip_campos_tabla USING g_repid 'I_DATOS'.
layout-box_fieldname = 'EXTRN'.
layout-box_tabname = 'I_DATOS'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_DATOS USING 'I_DATOS' g_repid .

*&---------------------------------------------------------------------*
*& Form TRAE_DATOS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
form trae_datos.

select vbeln kodat from likp into table i_likp
where kodat in p_kodat
and erdat in p_erdat.

if sy-subrc ne 0.
message i368(00) with 'No hay información'.
exit.
endif.

select * from lips into corresponding fields of table i_datos
for all entries in i_likp
where vbeln eq i_likp-vbeln
and werks in p_werks
and lgort in p_lgort
and matnr in p_matnr.
"and posnr < 900000.

*PASAMOS EL CAMPO KODAT(fecha pick)
loop at i_datos.
read table i_likp with key vbeln = i_datos-vbeln.
if sy-subrc = 0.
i_datos-kodat = i_likp-kodat.
modify i_datos.
endif.
endloop.

endform. " TRAE_DATOS



*---------------------------------------------------------------------*
* FORM SET_STATUS *
*---------------------------------------------------------------------*

form set_status using rt_extab type slis_t_extab.

set pf-status 'ZSTANDARD'. "Status nuevo
set titlebar 'T001'. "Titulo

endform.

*PARA VISUALIZACION
*&---------------------------------------------------------------------*
*& Form variant_inputhelp_f14
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_p_varia text
*----------------------------------------------------------------------*
form variant_inputhelp_f14 using p_variant like g_variant-variant.

* Esta rutina funciona como un search help recuperando los layouts
* creados por el usuario

data h_exit.

clear gx_variant.

call function 'REUSE_ALV_VARIANT_F4'
exporting
is_variant = g_variant
i_save = g_variant_save
importing
e_exit = h_exit
es_variant = gx_variant
exceptions
not_found = 1
program_error = 2
others = 3.

if sy-subrc is initial and h_exit is initial.
g_variant-variant = gx_variant-variant.
p_variant = gx_variant-variant.
else.
message id sy-msgid type 'S'
number sy-msgno
with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
endif.

endform. "variant_inputhelp_f14


*&---------------------------------------------------------------------*
*& Form get_default_variant_f14
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_VARIANT text
*----------------------------------------------------------------------*
form get_default_variant_f14 using p_variant like g_variant-variant.

* Recupera datos para luego poder recuperar los diferentes layouts....
gx_variant = g_variant.
clear gx_variant-variant.
clear gx_variant-text.

if not p_variant is initial.
gx_variant-variant = p_variant.
endif.

call function 'REUSE_ALV_VARIANT_DEFAULT_GET'
exporting
i_save = g_variant_save
changing
cs_variant = gx_variant
exceptions
wrong_input = 1
not_found = 2
program_error = 3
others = 4.

case sy-subrc.
when 0.
p_variant = gx_variant-variant.
when 2.
clear p_variant.
endcase.

endform. "get_default_variant_f14

*&---------------------------------------------------------------------*
*& Form USER_COMMAND
*&---------------------------------------------------------------------*

FORM USER_COMMAND USING r_ucomm LIKE sy-ucomm
rs_selfield TYPE slis_selfield.
*EN CASO DE TRASPASOS
data i_datos2 like i_datos occurs 0 with header line.
i_datos2[] = i_datos[].
CASE r_ucomm.
WHEN '%LOT'. "si presiona el boton lotes
"Loop a los que se hayan seleccionado
delete i_datos2 where extrn <> 'X'.
Loop at i_datos2 where EXTRN = 'X'.
"Bloqueamos las entregas
at new vbeln.
CALL FUNCTION 'ENQUEUE_EVVBLKE'
EXPORTING
MODE_LIKP = 'E'
MANDT = SY-MANDT
VBELN = i_datos2-vbeln
X_VBELN = ' '
_SCOPE = '2'
_WAIT = ' '
_COLLECT = ' '
EXCEPTIONS
FOREIGN_LOCK = 1
SYSTEM_FAILURE = 2
OTHERS = 3
.
IF SY-SUBRC <> 0.
message e386(00) with 'Error al bloquear Entrega' i_datos2-vbeln.
ENDIF.
endat.
endloop.

"una vez bloqueadas las entregas traemos los lotes de esas entregas
select matnr lgort werks charg clabs from mchb into corresponding
fields of
table i_mchb
for all entries in i_datos2 where
matnr = i_datos2-matnr
and lgort = i_datos2-lgort
and werks = i_datos2-werks
and not clabs = 0.

loop at i_mchb.
i_mchb-matnr2 = i_mchb-matnr.
i_mchb-werks2 = i_mchb-werks.
i_mchb-lgort2 = '0010'.
i_mchb-charg2 = i_mchb-charg.
i_mchb-clabs2 = i_mchb-clabs.
modify i_mchb.
endloop.

if sy-subrc = 0.
"una vez seleccionados los lotes dejamos solo la cantidad necesaria
"para cada entrega
"en caso que vengan materiales iguales.
" data i_mchbtemp like i_mchb occurs 0 with header line.
clear i_mchbtemp.
refresh i_mchbtemp.

loop at i_datos2.

loop at i_mchb where matnr = i_datos2-matnr.
i_mchb-vbeln = i_datos2-vbeln.
i_mchb-posnr = i_datos2-posnr.

if i_datos2-lfimg > i_mchb-clabs and i_datos2-lfimg <> 0.
i_datos2-lfimg = i_datos2-lfimg - i_mchb-clabs.
move-corresponding i_mchb to i_mchbtemp.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.
i_mchb-clabs = 0.
append i_mchbtemp.

modify i_mchb.
elseif i_datos2-lfimg = i_mchb-clabs and i_datos2-lfimg <> 0.
move-corresponding i_mchb to i_mchbtemp.
i_mchb-clabs = 0.
i_datos2-lfimg = 0.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.
append i_mchbtemp.
modify i_mchb.
"exit.
elseif i_datos2-lfimg < i_mchb-clabs and i_datos2-lfimg <> 0.
move-corresponding i_mchb to i_mchbtemp.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.

i_mchb-clabs = i_mchb-clabs - i_datos2-lfimg.
i_mchbtemp-clabs2 = i_datos2-lfimg.
i_datos2-lfimg = 0.
append i_mchbtemp.

modify i_mchb.
"exit.
endif.

if v_todosl = 'X'.
if i_mchb-clabs2 = i_mchb-clabs.
move-corresponding i_mchb to i_mchbtemp.
i_mchbtemp-clabs2 = 0.
append i_mchbtemp.
endif.
endif.

endloop.
endloop."i_datos2



"Mandamos el listado de los lotes para que lo modifique o lo acepte
PERFORM obt_descrip_campos_tabla USING g_repid 'I_MCHBTEMP'.
layout-box_fieldname = ''.
layout-box_tabname = ''.
PERFORM camb_descrip_campos_tabla USING 'CLABS2'
'transpasar'.

PERFORM asignar_edit_campo USING 'CLABS2' 'X'.
PERFORM carac_gen_listado.
estado = 'lotes'.
PERFORM visualizar_lista TABLES I_MCHBTEMP USING 'I_MCHBTEMP'
g_repid .

endif.
WHEN '&TRA'. "si presiona el boton traspasos
if estado is initial.
message e368(00) with 'Aun no ha seleccionado los lotes'.
else.
"comprobamos que no esten agarrando lotes de mas
data suma like i_mchbtemp-clabs.
loop at i_mchb.
suma = 0.
loop at i_mchbtemp where charg = i_mchb-charg.
suma = i_mchbtemp-clabs2 + suma.
if suma > i_mchb-clabs2.
message e138(00) with 'Error en lote' i_mchb-charg
' solo hay disponibles ' i_mchb-clabs.
endif.
endloop.
endloop.

"ya selecciono los lotes, de acuerdo a estos se manda llamar la
"un batch input a la MB1B con los traspasos que sean necesarios
PERFORM f_traspasa.
if v_traspaso = 'sin errores'.
PERFORM f_modificaentrega.
endif.
Clear i_MCHB.
refresh i_MCHB.
endif."estado initial.

ENDCASE.
ENDFORM.

*&---------------------------------------------------------------------*
*& Form f_traspasa

*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM f_traspasa.
DATA IMARA LIKE MARA OCCURS 0 WITH HEADER LINE.

Select matnr meins from MARA into corresponding fields of table IMARA
for all entries in I_MCHB
where MATNR = I_MCHB-MATNR.

DATA COPY_SYTABIX LIKE SY-TABIX.
loop at i_mchb.
i_mchb-clabs2 = i_mchb-clabs2 - i_mchb-clabs.
modify i_mchb.
if i_mchb-clabs2 = 0.
delete i_mchb.
endif.
endloop.

read table i_mchb index 1.
if sy-subrc = 0.

MOVE SY-TABIX TO COPY_SYTABIX.

* Apertura de un JD para las transacciones erróneas
*AT FIRST.
*PERFORM BDC_OPEN.
*ENDAT.

* Proceso de cada registro (cada registro es una transacción)
REFRESH BDC_TAB. "<------------------ Borrar la transacción anterior

perform DYNPRO using 'X' 'SAPMM07M' '0400'.
perform DYNPRO using '' 'BDC_CURSOR'
'MKPF-BUDAT'.
*perform DYNPRO using '' 'BDC_OKCODE'
* '=NPE'.
perform DYNPRO using '' 'RM07M-BWARTWA'
'311'.
perform DYNPRO using '' 'RM07M-WERKS'
i_mchb-werks.
perform DYNPRO using '' 'RM07M-LGORT'
i_mchb-lgort.
perform DYNPRO using '' 'XFULL'
'X'.
perform DYNPRO using '' 'RM07M-XNAPR'
'X'.
perform DYNPRO using '' 'RM07M-WVERS3'
'X'.
perform DYNPRO using '' 'BDC_OKCODE'
'=NPE'.
data i_mchblines like sy-tabix.
describe table i_mchb lines i_mchblines.
data xmeins(10).
LOOP AT I_MCHB.
read table imara with key matnr = i_mchb-matnr.
write imara-meins to xmeins.
perform DYNPRO using 'X' 'SAPMM07M' '0410'.
*perform DYNPRO using '' 'BDC_CURSOR'
* 'MSEG-UMLGO'.

perform DYNPRO using '' 'BDC_OKCODE'
'/00'.

perform DYNPRO using '' 'MSEG-MATNR'
i_mchb-matnr.
perform DYNPRO using '' 'MSEG-ERFMG'
i_mchb-clabs2 .
read table IMARA with key matnr = i_mchb-matnr.

perform DYNPRO using '' 'MSEG-ERFME'
xmeins.
perform DYNPRO using '' 'MSEG-WERKS'
i_mchb-werks.
perform DYNPRO using '' 'MSEG-LGORT'
i_mchb-lgort.
perform DYNPRO using '' 'MSEG-CHARG'
i_mchb-charg.
perform DYNPRO using '' 'MSEG-UMLGO'
i_mchb-lgort2.
perform DYNPRO using '' 'DKACB-FMORE'
'X'.
if i_mchblines <> 1.
i_mchblines = i_mchblines - 1.
perform DYNPRO using '' 'BDC_OKCODE'
'=NPE'.
endif.


perform DYNPRO using 'X' 'SAPLKACB' '0002'.
perform DYNPRO using '' 'BDC_OKCODE'
'=ENTE'.
ENDLOOP.

perform DYNPRO using 'X' 'SAPMM07M' '0410'.
perform DYNPRO using '' 'BDC_CURSOR'
'MSEG-ERFMG'.
perform DYNPRO using '' 'BDC_OKCODE'
'=BU'.
perform DYNPRO using 'X' 'SAPLKACB' '0002'.
perform DYNPRO using '' 'BDC_OKCODE'
'=ENTE'.

* Escribimos los mensajes de cada transacción para que salgan agrupa-
* dos con el mensaje de 'sin errores' o 'con errores' de su transacc.
* correspondiente. Para ello es necesario limpiar la tabla ERR_BI en
* cada transacción ya que el sistema no la limpia cuando llama a la
* transacción.
REFRESH ERR_BI.
CALL TRANSACTION 'MB1B' USING BDC_TAB MODE MODO MESSAGES INTO ERR_BI.
NEW-LINE.
IF SY-SUBRC = 0.
*WRITE:'Transacción', COPY_SYTABIX LEFT-JUSTIFIED, ': sin errores'.
v_traspaso = 'sin errores'.
ELSE.
v_traspaso = 'con errores'.
*WRITE:'Transacción', COPY_SYTABIX LEFT-JUSTIFIED, ': con errores'.
* Adición de la transacción errónea al JD para procesarlo on-line
* PERFORM BDC_INSERT.
ENDIF.

ENDIF."<--------------------------- I_MCHB tiene algo

ENDFORM. " CALLTRANSACTION

*&---------------------------------------------------------------------*
*& Form DYNPRO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM DYNPRO USING VALUE(DYNBEGIN)
VALUE(NAME)
VALUE(VALUE).

CLEAR BDC_TAB.
IF DYNBEGIN = 'X'.
BDC_TAB-PROGRAM = NAME.
BDC_TAB-DYNPRO = VALUE.
BDC_TAB-DYNBEGIN = 'X'.
ELSE.
BDC_TAB-FNAM = NAME.
BDC_TAB-FVAL = VALUE.
condense BDC_TAB-FVAL.
ENDIF.
APPEND BDC_TAB.
CLEAR BDC_TAB.

ENDFORM. " DYNPRO
*&---------------------------------------------------------------------*
*& Form f_modificaentrega
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_modificaentrega.
*<data i_mchbtmp like i_mchb occurs 0 with header line.
i_mchbtmp[] = i_mchbtemp[].
delete adjacent duplicates from i_mchbtmp comparing vbeln posnr.
"modificamos las entregas
data suma like i_mchbtmp-clabs2.
loop at i_datos where EXTRN = 'X'.


CALL FUNCTION 'DEQUEUE_EVVBLKE'
EXPORTING
MODE_LIKP = 'E'
MANDT = SY-MANDT
VBELN = i_datos-vbeln
X_VBELN = ' '
_SCOPE = '2'
_WAIT = ' '
_COLLECT = ' '
EXCEPTIONS
FOREIGN_LOCK = 1
SYSTEM_FAILURE = 2
OTHERS = 3
.
IF SY-SUBRC <> 0.
message e386(00) with 'Error al desbloquear Entrega' i_datos-vbeln.
ENDIF.
commit work and wait.

suma = 0.
loop at i_mchbtemp where vbeln = i_datos-vbeln
and posnr = i_datos-posnr.
suma = suma + i_mcHbtemp-clabs2.
endloop.
"verificamos que la suma de los lotes sea igual a la cantidad que
"necesita la posicion
if suma = i_datos-lfimg.
"modificamos posicion
perform f_modpos.
else.
message e368(00) with 'No concuerda' suma ' con ' i_datos-lfimg.
endif.
endloop.

leave program.
ENDFORM. " f_modificaentrega
*&---------------------------------------------------------------------*
*& Form f_modpos
*&---------------------------------------------------------------------*
* Modifica una posicion en la entrega una vez que se traspaso material
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_modpos.
"verifica si es posicion delas miles si es asi borrala y modifica la
"original
data ymeins like mara-meins.
data zmeins(10).


REFRESH BDC_TAB.
*METERMOS NUMERO DE ENTREGA
perform DYNPRO using 'X' 'SAPMV50A' '4004'.
perform DYNPRO using '' 'BDC_CURSOR'
'LIKP-VBELN'.
perform DYNPRO using '' 'BDC_OKCODE'
'/00'.
perform DYNPRO using '' 'LIKP-VBELN'
I_DATOS-VBELN.
*IR A LA PESTAÑA DE PICKING
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=T\02'.


*SI ES POSICION DE LAS 1000 LA BORRAMOS
if i_datos-posnr > 1000 and i_datos-posnr < 2000 .
*BUSCAR POSICION DE LAS 1000
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POPO_T'.
perform DYNPRO using 'X' 'SAPMV50A' '0111'.
perform DYNPRO using '' 'BDC_CURSOR'
'RV50A-POSNR
'.
perform DYNPRO using '' 'BDC_OKCODE'
'=WEIT'.
perform DYNPRO using '' 'RV50A-POSNR'
I_DATOS-POSNR.
*BORRAR POSICION DE LAS 1000
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POLO_T'.
perform DYNPRO using '' 'BDC_CURSOR'
'LIPS-POSNR(01)'.
perform DYNPRO using '' 'RV50A-LIPS_SELKZ(01)'
'X'.
i_datos-posnr = i_datos-posnr - 1000.
endif.



*BUSCAR POSICION ORIGINAL
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POPO_T'.

perform DYNPRO using 'X' 'SAPMV50A' '0111'.
perform DYNPRO using '' 'BDC_CURSOR'
'RV50A-POSNR'.
perform DYNPRO using '' 'BDC_OKCODE'
'=WEIT'.
perform DYNPRO using '' 'RV50A-POSNR'
I_DATOS-POSNR.
*CAMBIAR VALORES DE LA LINEA
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=CHSP_T'.
perform DYNPRO using '' 'LIPSD-G_LFIMG(01)'
i_datos-lfimg.
perform DYNPRO using '' 'LIPSD-PIKMG(01)'
i_datos-lfimg.
read table i_mchbtemp with key vbeln = i_datos-vbeln posnr =
i_datos-posnr.
perform DYNPRO using '' 'LIPS-LGORT(01)'
I_mchbtemp-LGORT2.

*HACER EL PICKING A LA POSICION
loop at i_mchbtemp where vbeln = i_datos-vbeln
and posnr = i_datos-posnr.

select single meins into ymeins from mara where matnr = i_datos-matnr.
write ymeins to zmeins.
perform DYNPRO using 'X' 'SAPMV50A' '3000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POAN_T'.
perform DYNPRO using '' 'LIPS-CHARG(01)'
I_MCHBTEMP-CHARG2.
perform DYNPRO using '' 'LIPS-LGORT(01)'
I_MCHBTEMP-LGORT2.
perform DYNPRO using '' 'LIPS-LFIMG(01)'
I_MCHBTEMP-CLABS2.
perform DYNPRO using '' 'LIPS-VRKME(01)'
zMEINS.
endloop.

*PARA CADA LINEA DE LOTE AGREGARLA
perform DYNPRO using 'X' 'SAPMV50A' '3000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=SICH_T'.

*LLAMA A LA TRANSACCION
CALL TRANSACTION 'VL02N' USING BDC_TAB MODE MODO.

if sy-subrc = 0.
message i368(00) with 'Se han modificado la entrega ' i_datos-vbeln
' posicion ' i_datos-posnr .


endif.


ENDFORM. " f_modpos

miércoles, 5 de octubre de 2011

Macro de excel

Sub Macro3()
' Macro de excel que mueve datos de un sheet a otro
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+w
'
Dim codigo As String
Dim direc As String
Dim num1 As Integer
Dim num2 As Integer
Dim num3 As Integer
Dim num4 As Integer

Sheets("Input Data").Select
[A2].Select
dato1 = "activo"
Do While Not IsEmpty(dato1)
Sheets("Input Data").Select
codigo = ActiveCell
num2 = 0
'ActiveCell.Offset(num1, num2).Select
dato1 = ActiveCell.Offset(num1, num2)
If Not IsEmpty(dato1) Then
num2 = num2 + 1
dato2 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato3 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato4 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato5 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato6 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato7 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato8 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato9 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato10 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato11 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato12 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato13 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato14 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato15 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato16 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato17 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato18 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato19 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato20 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1


Sheets("Upload").Select
[A1].Select
num2 = 0
ActiveCell.Offset(num3, num2) = "H"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato3
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato2
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato4
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato6
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato8
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato10

num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "R"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato7 * -1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato7 * -1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato8
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato16
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato14
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5


num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "G"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato11
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato12
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato12
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato15
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato16
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato14
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato17


num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "T"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = 0
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = 0
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num3 = num3 + 1
num1 = num1 + 1
End If
Loop

End Sub

lunes, 3 de octubre de 2011

Reporte ABAP imprime las direcciones de correo de clientes

*PROGRAMA QUE IMPRIME LAS DIRECCIONES DE CORREO DE LOS CLIENTES
REPORT ZDIR.
data i_kna1 like kna1 occurs 0 with header line.
data i_adr6 like adr6 occurs 0 with header line.

select * from kna1 into table i_kna1.

select * from adr6 into table i_adr6 for all entries in i_kna1
where addrnumber = i_kna1-adrnr.

loop at i_kna1.
read table i_adr6 with key addrnumber = i_kna1-adrnr.
if sy-subrc <> 0.
i_adr6-smtp_addr = ''.
endif.
write : / i_kna1-kunnr ,i_kna1-stcd1, i_kna1-name1, i_kna1-name2,
i_adr6-smtp_addr.
endloop.

miércoles, 24 de agosto de 2011

Programa ABAP listado de Compras

*Un ejemplo de uso de un ALV que al darle doble click trae las posiciones de un pedido *de compras (lleva un include, esta mas abajo).
REPORT ZPEDIDOS_COMPRAS .
TABLES: EKKO.


*TABLAS
data i_ekko like ekko occurs 0 with header line."cabecera compras
data i_ekpo like ekpo occurs 0 with header line."Posiciones doc compras
data I_eket like eket occurs 0 with header line."repartos del plan entr
data i_ekkn like ekkn occurs 0 with header line."imputacion doc compras
data i_lfa1 like lfa1 occurs 0 with header line."Maestro de proveedores

data begin of i_out occurs 0.
data:
EBELN like EKPO-EBELN,"documento compras
* FRYEAR like CF001-YEARB,"ejercicio
* PERIO like COEPB-PERIO,"periodo
AEDAT like EKKO-AEDAT,"Fecha de creacion del registro
EINDT like EKET-EINDT,"fecha de entrega de posicion
EBELP like EKPO-EBELP,"posicion
* "BNFPO like EKET-BNFPO,"Numero de posicion de la solicitud de
TXZ01 like EKPO-TXZ01,"Texto Breve
MENGE like EKKN-MENGE,"Cantidad
* WEMNG like EKET-WEMNG,"Cantidad entrada de mercancias
* "CANTIDAD PENDIENTE
* OWEMG like RM06A-owemg,"Cantidad Pendiente
MEINS like EKPO-MEINS,"unidad de medida
NETPR like EKPO-NETPR,"Precio neto
LIFNR like EKKO-LIFNR,"Proveedor
NAME1 like LFA1-NAME1,"Nombre del proovedor
NETWR like EKPO-NETWR,"valor neto pedido en moneda de pedido
WAERS like EKKO-WAERS,"Moneda del documento
NTGEW like EKPO-NTGEW,"peso
ORT01 like LFA1-ORT01,"Poblacion
WERKS like EKPO-WERKS."Centro
* ZNETWR like zmiscampos-ZNETWR,"valor entregado
* "IMPORTE PENDIENTE
* OWEWR like RM06A-OWEWR,"valor pendiente entrada de mercancia
* BEDAT like EKKO-BEDAT,"Fecha de documento de compras

* BANFN like EKET-BANFN,"Numero de la solicitud de pedido
* AFNAM like EKPO-AFNAM,"Nombre del solicitante
* SAKTO like EKKN-SAKTO,"Numero de la cuenta de mayor
* KOSTL like EKKN-KOSTL."Centro de coste

* EKKN like EKKN-NETWR,"Valor neto de pedido en mon pedido
* BRTWR like EKPO-BRTWR,"valor bruto pedido en moneda del pedido
*
* KDATB like EKKO-KDATB,"in. periodo de validez
* KDATE like EKKO-KDATE."fin periodo de validez
data end of i_out.
data i_out2 like i_out occurs 0 with header line.
data begin of i_TEMP occurs 0.
data:
EBELN like EKPO-EBELN,"documento compras
* FRYEAR like CF001-YEARB,"ejercicio
* PERIO like COEPB-PERIO,"periodo
AEDAT like EKKO-AEDAT,"Fecha de creacion del registro
EINDT like EKET-EINDT,"fecha de entrega de posicion
* EBELP like EKPO-EBELP,"posicion
* "BNFPO like EKET-BNFPO,"Numero de posicion de la solicitud de
* TXZ01 like EKPO-TXZ01,"Texto Breve
* MENGE like EKKN-MENGE,"Cantidad
* WEMNG like EKET-WEMNG,"Cantidad entrada de mercancias
* "CANTIDAD PENDIENTE
* OWEMG like RM06A-owemg,"Cantidad Pendiente
* MEINS like EKPO-MEINS,"unidad de medida
* NETPR like EKPO-NETPR,"Precio neto
LIFNR like EKKO-LIFNR,"Proveedor
NAME1 like LFA1-NAME1,"Nombre del proovedor
NETWR like EKPO-NETWR,"valor neto pedido en moneda de pedido
WAERS like EKKO-WAERS,"Moneda del documento
NTGEW like EKPO-NTGEW,"peso
ORT01 like LFA1-ORT01,"Poblacion
WERKS like EKPO-WERKS."Centro
* ZNETWR like zmiscampos-ZNETWR,"valor entregado
* "IMPORTE PENDIENTE
* OWEWR like RM06A-OWEWR,"valor pendiente entrada de mercancia
* BEDAT like EKKO-BEDAT,"Fecha de documento de compras

* BANFN like EKET-BANFN,"Numero de la solicitud de pedido
* AFNAM like EKPO-AFNAM,"Nombre del solicitante
* SAKTO like EKKN-SAKTO,"Numero de la cuenta de mayor
* KOSTL like EKKN-KOSTL."Centro de coste

* EKKN like EKKN-NETWR,"Valor neto de pedido en mon pedido
* BRTWR like EKPO-BRTWR,"valor bruto pedido en moneda del pedido
*
* KDATB like EKKO-KDATB,"in. periodo de validez
* KDATE like EKKO-KDATE."fin periodo de validez
data end of i_TEMP.
*VARIABLES
data: ekpo_lines TYPE i,
gd_percent TYPE i.

* ALV
data repname like sy-repid.

SELECTION-SCREEN BEGIN OF BLOCK block1 WITH FRAME TITLE text-001.


SELECT-OPTIONS:
* SO_KOSTL for i_EKKN-KOSTL,"centro de coste
SO_EBELN for i_EKPO-EBELN,"documento compras
SO_AEDAT for ekko-AEDAT obligatory.
SELECTION-SCREEN END OF BLOCK block1.

INCLUDE ZLISTA_COMPRASI.
*INCLUDE ZPEDIDOS_COMPRASI.
at user-command.
break-point.

START-OF-SELECTION.
perform f_trae_datos.
perform f_procesa_datos.
perform f_suma_iguales.
perform f_genera_alv.







*********INCLUDE************(ZLISTA_COMPRASI)
*----------------------------------------------------------------------*
***INCLUDE ZPEDIDOS_COMPRASI .
*----------------------------------------------------------------------*
*&---------------------------------------------------------------------*
*& Form f_trae_datos
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_trae_datos.
*traemos las cabeceras de los doc de compras de acuerdo a parametros
Select * from ekko into table i_ekko
where AEDAT in SO_AEDAT
and EBELN in SO_EBELN.
if sy-subrc = 0.
*traemos datos Posiciones de doc compras
Select * from EKPO into table i_ekpo
for all entries in i_ekko
where EBELN = i_ekko-EBELN.
*traemos datos imputacion doc compras
Select * from EKKN into table i_ekkn
for all entries in i_ekko
where EBELN = i_ekko-EBELN.
*traemos datos repartos plan de entregas
Select * from EKET into table i_ekET
for all entries in i_ekko
where EBELN = i_ekko-EBELN.
*traemos datos de maestro de proveedores
Select * from LFA1 into table i_lfa1
for all entries in i_ekko
where lifnr = i_ekko-lifnr.
endif."sy-subrc
ENDFORM. " f_trae_datos
*&---------------------------------------------------------------------*
*& Form f_procesa_datos
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_procesa_datos.
describe table i_ekpo lines ekpo_lines.



loop at i_ekpo.
PERFORM progress_bar USING 'Cargando...'(002)
sy-tabix
ekpo_lines.


read table i_ekko with key ebeln = i_ekpo-EBELN.
if sy-subrc = 0.
move-corresponding i_ekko to i_out.
endif.

read table i_ekkn with key ebeln = i_ekpo-EBELN.
if sy-subrc = 0.
move-corresponding i_ekkn to i_out.
endif.

read table i_eket with key ebeln = i_ekpo-EBELN.
if sy-subrc = 0.
move-corresponding i_eket to i_out.
endif.

read table i_lfa1 with key lifnr = i_ekko-lifnr.
if sy-subrc = 0.
move-corresponding i_lfa1 to i_out.
endif.

*i_out-perio = i_eket-EINDT+4(2).
*i_out-FRYEAR = i_eket-EINDT+0(4).
move-corresponding i_ekpo to i_out.
append i_out.
clear i_out.
endloop.

*BORRAMOS LOS QUE NO ESTEN EN EL PARAMETRO CENTRO DE COSTE
*if not SO_KOSTL is initial.
*delete i_out where not kostl in SO_KOSTL.
*endif.
*TRAEMOS LOS CAMPOS
DATA: BEGIN OF vlist OCCURS 0,
filler1(1000) TYPE c,
field1(100) TYPE c,
END OF vlist.

DATA BEGIN OF itab_list OCCURS 0.
INCLUDE STRUCTURE abaplist.
DATA END OF itab_list.

DATA BEGIN OF vlist_s OCCURS 0.
DATA line(100).
DATA END OF vlist_s.
DATA TPOS(1).
data texto(100).
*LOOP A LA TABLA DE SALIDA PARA LLENAR LOS 2 CAMPOS CANTIDAD PENDIENTE
* E IMPORTE PENDIENTE USANDO LA TRANSACCION me2l
*LOOP AT I_OUT.
*clear vlist.
*refresh vlist.
*SUBMIT RM06EL00 AND RETURN
* WITH LISTU = 'BEST'
* WITH S_EBELN = I_OUT-EBELN
* EXPORTING LIST TO MEMORY.
*
*CALL FUNCTION 'LIST_FROM_MEMORY'
* TABLES
* listobject = itab_list
* EXCEPTIONS
* not_found = 4
* OTHERS = 8.
*
*CALL FUNCTION 'LIST_TO_ASCI'
* EXPORTING
* list_index = -1
* TABLES
* listasci = vlist
* listobject = itab_list
* EXCEPTIONS
* empty_list = 1
* list_index_invalid = 2
* OTHERS = 3.
*
**DE LA LISTA QUE TRAE TOMAMOS PARA LA POSICION REQUERIDA LOS CAMPOS
*LOOP AT VLIST.
* condense vlist-filler1.
* split vlist at space into table vlist_s.
* read table vlist_s index 2.
* texto = I_OUT-EBELP.
* if vlist_s-line cs texto.
* tpos = 'X'.
* endif.
* if tpos = 'X'.
* read table vlist_s index 3.
* if vlist_s-line = 'entregar'.
* read table vlist_s index 4.
* perform f_elimina_caracteres using vlist_s-line.
* I_OUT-OWEMG = vlist_s-line.
* read table vlist_s index 6.
* perform f_elimina_caracteres using vlist_s-line.
* I_OUT-OWEWR = vlist_s-line.
*
**EUROS
* if i_out-waers = 'EUR'.
* I_OUT-OWEWR = I_OUT-OWEWR * 10.
* endif.
*
* tpos = ''.
* "valor entregado
* I_OUT-ZNETWR = I_OUT-NETWR - I_OUT-OWEWR.
* modify i_out.
* exit.
* endif.
* endif."X
*
*ENDLOOP.
*ENDLOOP. "I_OUT
ENDFORM. " f_procesa_datos
*&---------------------------------------------------------------------*
*& Form f_genera_alv
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_genera_alv.
repname = sy-repid.
PERFORM obt_descrip_campos_tabla USING repname 'I_TEMP'.
PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_TEMP USING 'I_TEMP' repname .
ENDFORM. " f_genera_alv


**------------------------------------------------
** f_elimina_caracteres.
**------------------------------------------------
form f_elimina_caracteres changing texto.
data: len type i, caracter, va type i,texto2(5000) type c.
*creamos tabla interna con los caracteres a eliminar de el archivo
data: begin of i_careli occurs 0,
car,
end of i_careli.
*cuales caracteres queremos quitar =,<,>,~,/,”,’,+,*,|,:,
i_careli-car = ','.append i_careli.
va = 0.

len = strlen( texto ).
while va <= len.

caracter = texto+va(+1).
loop at i_careli.
if i_careli-car = caracter.
caracter = ''.
endif.
endloop.
concatenate texto2 caracter into texto2.
va = va + 1.
endwhile.
texto = texto2.
endform.

*&---------------------------------------------------------------------*
*& Form f_suma_iguales
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_suma_iguales.
data suma like i_out-netwr.
data vEBELN like i_out-EBELN.

loop at i_out.
at new EBELN.
vEBELN = i_out-ebeln.
suma = 0.
loop at i_out where EBELN = vEBELN.
suma = suma + i_out-netwr.
endloop.
move-corresponding i_out to i_temp.
i_temp-netwr = suma.
read table i_ekko with key EBELN = VEBELN.
if sy-subrc = 0.
i_temp-aedat = i_ekko-aedat.
endif.
append i_temp.
endat.
endloop.

I_OUT2[] = I_OUT[].
ENDFORM. " f_suma_iguales

*&---------------------------------------------------------------------*
*& Form PROGRESS_BAR
*&---------------------------------------------------------------------*
FORM progress_bar USING p_value
p_tabix
p_nlines.

DATA: w_text(40),
w_percentage TYPE p,
w_percent_char(3).

w_percentage = ( p_tabix / p_nlines ) * 100.
if w_percentage = 100.
w_percentage = 99.
endif.
w_percent_char = w_percentage.
SHIFT w_percent_char LEFT DELETING LEADING ' '.
CONCATENATE p_value w_percent_char '% ' INTO w_text.

* This check needs to be in otherwise when looping around big tables
* SAP will re-display indicator too many times causing report to run
* very slow. (No need to re-display same percentage anyway)

if w_percentage gt gd_percent or p_tabix eq 1.

CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
percentage = w_percentage
text = w_text.
gd_percent = w_percentage.
endif.
endform.




















































*----------------------------------------------------------------------*
* INCLUDE ZALV *
*----------------------------------------------------------------------*

************************************************************************
* Include ZALV: Subrutinas para listado ALV. *
************************************************************************

* Es necesario incluir este include en el inicio del programa.
* El inicio del código tiene que empezar por STAR-OF-SELECTION, o no
* lo reconocerá.
* IMPORTANTISIMO. Es obligatorio incluir la 1ª form, y la última.

* Listado de Forms.
* 1.- OBT_DESCRIP_CAMPOS_TABLA "Esta form es OBLIGATORIA.

* 2.- CAMB_DESCRIP_CAMPOS_TABLA "Cambia la descrip de cabecera
* 3.- ELIM_CAMPOS_DE_VISUALIZACION"No se visualizan los campos seleccio
* 4.- CARAC_GEN_LISTADO "Da formato al listado
* 5.- ASIGNAR_MONEDA_COLUMNA "Asignamos una campo de moneda
* 6.- ASIGNAR_UNIDAD_MEDIDA "Asignamos una unidad de medida
* 7.- ALV_F4 "Match code para varientes
* 8.- CHEQUEO_VARIANTE_EXISTE "Comprueba que exista la variante
* 9.- ASIGNAR_VARIANTE "Asignamos la variante al listado
* 10.- ENCABEZADO "Llamamos a esta función para inserta
* 11.- ASIGN_O_QUITAR_CAMPO_CLAVE "Asigna o quita la prop. de Campo Cla
* 12.- Indicar_campo_checkbox "Definir una columna como checkbox

* 13.- ASIGNAR_USER_COMMAND "Equivalente a AT USER-COMMAND
* 14.- Asignar_TOP_OF_PAGE "Deberemos crear FORM TOP_OF_PAGE2
* 15.- Asignar_PF_STATUS "Asigna un STATUS a un listado

* 16.- VISUALIZAR_LISTA "Visualizar la lista. OBLIGATORIA
* 17.- Asignar END_OF_PAGE "
* 18.- Opciones de Impresión
* 19.- Asignar_edit_campo "Campo editable en alv
* 20.- Asignar_hotspot "Activa o desactiva el hotspot

* Normalmente como mínimo es necesario este código si la tabla es I_TAB
* repname = sy-repid.
* PERFORM obt_descrip_campos_tabla USING repname 'I_TAB'.
* PERFORM carac_gen_listado.
* PERFORM visualizar_lista TABLES I_TAB USING 'I_TAB' repname .


*$*$ Definición de variables para el listado
TYPE-POOLS: slis.
DATA: "repname LIKE sy-repid ,
layout TYPE slis_layout_alv,
printer TYPE slis_print_alv,
f2code LIKE sy-ucomm VALUE '&ETA',
fieldtab TYPE slis_t_fieldcat_alv,
heading TYPE slis_listheader OCCURS 0 ,
g_save(1) TYPE c VALUE 'A',
fausti LIKE tbsl-faus1, " string de campos obligatorios
event TYPE slis_alv_event OCCURS 0 with header line,
events TYPE slis_alv_event OCCURS 0,
sort TYPE slis_t_sortinfo_alv,
sort_header TYPE slis_sortinfo_alv,
variant LIKE disvariant,
user_command TYPE slis_formname,
status TYPE slis_formname.

CONSTANTS:
formname_top_of_page TYPE slis_formname VALUE 'TOP_OF_PAGE',
formname_end_of_list TYPE slis_formname VALUE 'END_OF_LIST',
formname_user_command TYPE slis_formname VALUE 'USER_COMMAND',
formname_pf_status_set TYPE slis_formname VALUE 'PF_STATUS'.

FIELD-SYMBOLS TYPE slis_fieldcat_alv.

*$*$ Definición de Forms de listado

*__________________________________________Form obt_descrip_campos_tabla
FORM obt_descrip_campos_tabla USING p_repname
p_tablename TYPE slis_tabname.
* Esta es la primera form que se tiene que llamar. Así recogemos
* Los atributos de todos los campos de la tabla interna.
* Importante!!: La tabla interna no se tiene que definir como un data
* referenciado a una estructura type (Si se hace de este modo no
* reconocerá ningún campo). Utilizar siempre:
* Data begin of ..... occurs 0.
* Data end of ......
* No utilizar tampoco: Data: itab type standard table of ...............
REFRESH fieldtab.
CALL FUNCTION 'REUSE_ALV_FIELDCATALOG_MERGE'
EXPORTING
i_program_name = p_repname
i_internal_tabname = p_tablename
i_inclname = p_repname
CHANGING
ct_fieldcat = fieldtab.

ENDFORM.

*_________________________________________FORM Camb_descrip_campos_tabla
FORM camb_descrip_campos_tabla USING p_campo TYPE slis_fieldname
p_descrip.

* Para utilizar esta form previamente tenemos que haber llamado a la
* form obt_descrip_campos_tabla. Tenemos que pasarle el campo de la
* tabla interna y la descripción que queremos que aparezca en la
* cabecera de la columna.

READ TABLE fieldtab WITH KEY fieldname = p_campo ASSIGNING .
IF sy-subrc EQ 0.
-seltext_l = p_descrip.
* -seltext_m = p_descrip.
* -seltext_s = p_descrip.
* -reptext_ddic = p_descrip.
ENDIF.

ENDFORM.

*______________________________________FORM elim_campos_de_visualizacion
FORM elim_campos_de_visualizacion USING p_campo TYPE slis_fieldname.
* Consigue que un campo clave se pueda quitar de la visualización.
* P. Ej. Mandante.
* Tambien elimina de la visualización cualquier campo que no sea clave.
* Desde dentro del listado estos campos se pueden volver a visualizar.

READ TABLE fieldtab WITH KEY fieldname = p_campo ASSIGNING .
IF sy-subrc EQ 0.
-key_sel = 'X'.
-no_out = 'X'.
ENDIF.
ENDFORM.
*_______________________________________________Carac. gen. del listado.
FORM carac_gen_listado.
*Esta Form contiene características generales del listado. Si se quieren
*estas mismas llamar a la Form, en caso contrario implementarlas desde
*el programa. La estructura de características generales es 'LAYOUT'.
*En El campo INFO_FIELDNAME se le indica la columna que contiene el
*color para cada registro. Si dicha columna, no tiene valor para algún
*registro, dicho registro tendrá el color standard que le toque.
* El formato que tiene que tener la columa COLOR es:
* 'Cxy':
* C = color (all codes must start with 'C')
* x = color number ('1'-'9')
* y = bold ('0' = off, '1' = on)

*__Indicamos que queremos el listado cebreado
layout-zebra = 'X'.
*__No afecta porque tenemos user-commmand
layout-detail_popup = 'X'.
*__Indicamos que Al hacer doble click el user-command = 'DOBCLICK'.
layout-f2code = 'USER_COMMAND'.
*__Si queremos que al hacer doble click despliegue la ventana desasteris
* layout-f2code = '&ETA'.
layout-info_fieldname = 'COLOR'.
* layout-flexible_key = 'X'. "Permite mover campos clave.
layout-colwidth_optimize = 'X'.
layout-detail_initial_lines = 'X'.
layout-detail_titlebar = 'Información Adicional'. "Titulo popup
layout-totals_only = 'X'.
layout-detail_popup = 'X'.

ENDFORM. " BUILD_LAYOUT

*____________________________________________FORM asignar_moneda_columna
FORM asignar_moneda_columna USING p_columna TYPE slis_fieldname
p_campo_moneda TYPE slis_fieldname.
* En esta form hay que pasar la columna que tiene los importes, y la
* Columna que contiene la moneda para cada registro.
READ TABLE fieldtab WITH KEY fieldname = p_columna ASSIGNING .
IF sy-subrc EQ 0.
-cfieldname = p_campo_moneda.
ENDIF.

ENDFORM.

*_____________________________________________FORM asignar_unidad_medida
FORM asignar_unidad_medida USING p_columna TYPE slis_fieldname
p_campo_moneda TYPE slis_fieldname.
* En esta form hay que pasar la columna que tiene las cantidades, y la
* Columna que contiene la unidad para cada registro.
READ TABLE fieldtab WITH KEY fieldname = p_columna ASSIGNING .
IF sy-subrc EQ 0.
-qfieldname = p_campo_moneda.
ENDIF.

ENDFORM.

*____________________________________________________________Form Alv_F4
FORM alv_f4 USING p_repname LIKE sy-repid
p_variante LIKE disvariant-variant.

* Esta form devuelve un matchcode con las variantes existentes.
* Tan solo se tiene que poner si se quiere cargar una variante de
* visualización.
* Para poner esta form se tiene que poner:

**** at selection-screen on value-request for p_variante. *****
**** perform alv_f4 using (Nombreprograma) (Variable_variante). *****
variant-report = p_repname.
CALL FUNCTION 'REUSE_ALV_VARIANT_F4'
EXPORTING
is_variant = variant
i_save = 'A'
IMPORTING
es_variant = variant
EXCEPTIONS
not_found = 2.
IF sy-subrc = 2.
MESSAGE ID sy-msgid TYPE 'S' NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
ELSE.
p_variante = variant-variant.
ENDIF.
ENDFORM.

*___________________________________________FORM chequeo_variante_existe
FORM chequeo_variante_existe USING p_repname LIKE sy-repid
p_variante LIKE disvariant-variant.

* Esta form solo se tiene que usar si se quiere cargar una variante de
* visualización al sacar el listado.
* Esta form valida que la variante introducida por pantalla exista, en
* caso contrario da un mensaje de error.

*IMPLEMENTACIÓN.
*****at selection-screen. *****
***** perform alv_check USING (Nombre_prog) (variable_variante). *****

variant-report = p_repname.
variant-variant = p_variante.
IF NOT p_variante IS INITIAL.
CALL FUNCTION 'REUSE_ALV_VARIANT_EXISTENCE'
EXPORTING
i_save = 'A'
CHANGING
cs_variant = variant
EXCEPTIONS
OTHERS = 1.
IF sy-subrc <> 0.
MESSAGE e321(m7) WITH p_variante variant-report.
ENDIF.
ENDIF.

ENDFORM.

*______________________________________________________Asignar variante.
FORM asignar_variante USING p_repname LIKE sy-repid
p_variante LIKE disvariant-variant.
* Si se quiere visualizar una variante es obligatorio llamar a esta form
* No es suficiente con llamar a la función de matchcode, o a la form de
* verificación.
CLEAR variant.
variant-report = p_repname.
variant-variant = p_variante.
ENDFORM.

*_______________________________________________________FORM top_of_page
FORM encabezado USING p_linea TYPE slis_entry .
* TOP-OF-PAGE, Se tiene que pasar línea a línea. Se tiene que rellenar
* una variable TYPE slis_entry, que tiene 60 posiciones, y enviarla a
* la form, para cada nueva línea del top-of-page se tiene que volver a
* llamar a la form enviando la nueva línea.

IF events[] IS INITIAL.
DATA: ls_event TYPE slis_alv_event.
CALL FUNCTION 'REUSE_ALV_EVENTS_GET'
EXPORTING
i_list_type = 0
IMPORTING
et_events = events.
ENDIF.
*___Indicamos que tiene que tener TOP-OF-PAGE
READ TABLE events WITH KEY name = slis_ev_top_of_page
INTO ls_event.
IF sy-subrc = 0.
MOVE formname_top_of_page TO ls_event-form.
APPEND ls_event TO events.
ENDIF.
DELETE ADJACENT DUPLICATES FROM heading COMPARING ALL FIELDS.
DATA: hline TYPE slis_listheader.
hline-typ = 'H'.
hline-info = p_linea.
APPEND hline TO heading.
CLEAR: hline, p_linea.

ENDFORM.

*________________________________________FORM ASIGN_O_QUITAR_CAMPO_CLAVE
FORM asign_o_quitar_campo_clave USING p_campo TYPE fieldname
p_x TYPE char1.
*Esta form asigna o quita la propiedad de campo clave. Los campos clave
*Aparecen en color azul a la izquierda de la pantalla, y se quedan
*Bloqueados sin que se puedan mover.
TRANSLATE p_campo TO UPPER CASE.
READ TABLE fieldtab WITH KEY fieldname = p_campo ASSIGNING .
IF sy-subrc EQ 0.
-key = p_x.
ENDIF.
ENDFORM.

*____________________________________________form asignar_ancho_columna
FORM asignar_ancho_columna USING p_campo TYPE fieldname
long TYPE i.
* Esta rutina asigna un ancho a la columna. No es necesario indicarlo
* porque por defecto coge la longitud de la variable.
TRANSLATE p_campo TO UPPER CASE.
READ TABLE fieldtab WITH KEY fieldname = p_campo ASSIGNING .
IF sy-subrc EQ 0.
-outputlen = long.
ENDIF.

ENDFORM.

*____________________________________________Form Indicar_campo_checkbox
FORM indicar_campo_checkbox USING p_campo TYPE fieldname.

* Esta rutina asigna a una columna la propiedad de checkbox.
* El parámetro import es el nombre del campo.
layout-box_fieldname = p_campo.
ENDFORM.

*_______________________________________________________FORM top_of_page
FORM top_of_page.
*Esta función es interna, y no se tiene que llamar desde el programa de
* control
CALL FUNCTION 'REUSE_ALV_COMMENTARY_WRITE'
EXPORTING
i_logo = 'LOGO_SOS'
it_list_commentary = heading.
ENDFORM.

*______________________________________________FORM asignar_user_command
FORM asignar_user_command.
* Se tiene que crear una form dentro del programa de control que tenga
* implementado lo que se quiere hacer en el AT-LINE-SELECTION o
* AT USER COMMAND
* La form que se construya tiene que tener la structura:

*****form user_command using r_ucomm like sy-ucomm *******
***** rs_selfield type slis_selfield. *******

* El campo r_ucomm devuelve el código '&ETA' si es un doble click
* la estructura rs_selfield contiene los siguientes campos.

* tabname : Nombre de la tabla interna
* tabindex : Indice de la tabla interna
* fieldname: Campo en el que estaba posicionado el cursor
* sel_tab_field: Nombre de la celda donde estaba posicionado el cursor
* endsum : El cursor está sobre la linea de suma final
* sumindex : Si es mayor que cero, indica que es una linea de subtotal
* value : valor del campo de la lista
* refresh : (exporting) Se refresca la lista, la lista act. desaparece.
* col_stable:(exporting) keep column positions in refresh
DATA: ls_event TYPE slis_alv_event.
FIELD-SYMBOLS LIKE ls_event.
IF events[] IS INITIAL.
CALL FUNCTION 'REUSE_ALV_EVENTS_GET'
EXPORTING
i_list_type = 0
IMPORTING
et_events = events.
ENDIF.
*___Indicamos que tiene el evento User-command: At-line-selection
READ TABLE events WITH KEY name = slis_ev_user_command
ASSIGNING .
CHECK sy-subrc = 0.
MOVE formname_user_command TO -form.
ENDFORM.

*_______________________________________________Form asignar_TOP_OF_PAGE
FORM asignar_top_of_page.
* Para el TOP-OF-PAGE, tendremos que crear una rutina que se llame
* ALV_TOP_OF_PAGE. Dentro de esta rutina podremos escribir la cabecera
* que queramos al modo tradicional (Con Writes).

DATA: ls_event TYPE slis_alv_event.
FIELD-SYMBOLS LIKE ls_event.
IF events[] IS INITIAL.
CALL FUNCTION 'REUSE_ALV_EVENTS_GET'
EXPORTING
i_list_type = 0
IMPORTING
et_events = events.
ENDIF.
READ TABLE events WITH KEY name = slis_ev_top_of_page
ASSIGNING .
CHECK sy-subrc = 0.
-form = 'ALV_TOP_OF_PAGE'.
ENDFORM.

*_____________________________________________Form asignar_SET_PF_STATUS
FORM asignar_set_pf_status USING p_status.
* Tenemos que pasar como variable el STATUS que queremos asignar al
* listado.

DATA: ls_event TYPE slis_alv_event.
FIELD-SYMBOLS LIKE ls_event.
IF events[] IS INITIAL.
CALL FUNCTION 'REUSE_ALV_EVENTS_GET'
EXPORTING
i_list_type = 0
IMPORTING
et_events = events.
ENDIF.
READ TABLE events WITH KEY name = slis_ev_pf_status_set
ASSIGNING .
CHECK sy-subrc = 0.
-form = p_status.
SET PF-STATUS p_status.
ENDFORM.

*__________________________________________________FORM visualizar_lista
FORM visualizar_lista TABLES p_itab
USING p_tablename TYPE slis_tabname
p_repname LIKE sy-repid.
* valores del g_save.
* ' ' = No se pueden salvar las variantes de visualización
* 'X' = Solo se pueden salvar las variantes standard
* 'U' = Solo se pueden salvar las variantes de usuario
* 'A' = Se pueden guardar todas las variantes.

DATA: e_exit_caused_by_caller.


CALL FUNCTION 'REUSE_ALV_LIST_DISPLAY'
EXPORTING
i_callback_program = p_repname
i_callback_pf_status_set = status
i_structure_name = p_tablename
is_layout = layout
it_fieldcat = fieldtab
i_default = 'A'
i_save = g_save
it_sort = sort
it_events = event[]
is_variant = variant
is_print = printer
i_callback_user_command = 'USER_COMMAND'
IMPORTING
e_exit_caused_by_caller = e_exit_caused_by_caller
TABLES
t_outtab = p_itab.

ENDFORM.
*_______________________________________________Form asignar_END_OF_LIST
FORM asignar_end_of_list.
* Para el END-OF-LIST, tendremos que crear una rutina que se llame
* ALV_END_OF_LIST. Dentro de esta rutina podremos escribir un párrafo
* al final que queramos al modo tradicional (Con Writes).

DATA: ls_event TYPE slis_alv_event.
FIELD-SYMBOLS LIKE ls_event.
IF events[] IS INITIAL.
CALL FUNCTION 'REUSE_ALV_EVENTS_GET'
EXPORTING
i_list_type = 0
IMPORTING
et_events = events.
ENDIF.
READ TABLE events WITH KEY name = slis_ev_end_of_list
ASSIGNING .
CHECK sy-subrc = 0.
-form = 'ALV_END_OF_LIST'.
ENDFORM.
*_______________________________________________Form opciones_impresora
FORM opciones_impresora.
*Esta Form contiene características para la impresora.

*__Indicamos que no salga la página de selección.
printer-no_print_selinfos = 'X'.
printer-no_print_listinfos = 'X'.

ENDFORM. " OPCIONES_IMPRESORA
*_______________________________________________Form asignar_edit_campo
*esta form permite hacer un campo de la alv que sea editable

FORM asignar_edit_campo USING p_campo TYPE slis_fieldname
char1.

READ TABLE fieldtab WITH KEY fieldname = p_campo ASSIGNING .
IF sy-subrc EQ 0.
-input = char1.
* -seltext_m = p_descrip.
* -seltext_s = p_descrip.
* -reptext_ddic = p_descrip.
ENDIF.
ENDFORM. " asignar_edit_campo

*&---------------------------------------------------------------------*
*& Form activar_hotspot
*&---------------------------------------------------------------------*
FORM activar_hotspot USING p1 TYPE slis_fieldname
p2.

READ TABLE fieldtab WITH KEY fieldname = p1 ASSIGNING .
IF sy-subrc = 0.
-hotspot = p2.
ENDIF.

ENDFORM. " activar_hotspot