/* inclucion de constantes de excel*/
{libConstExcel.i}
PROCEDURE pGeneraExcel:
/*------------------------------------------------------------------------------
Purpose: Generar Archivo Excel a partir de una TEMP-TABLE o CSV
Parameters: INPUT PARAMETER pihTT AS HANDLE
INPUT PARAMETER picProperties AS CHARACTER
Notes:
------------------------------------------------------------------------------*/
/*--- definicion de parametros ---*/
DEFINE INPUT PARAMETER pihTT AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER picProperties AS CHARACTER NO-UNDO.
/*--- definicion de varibles para invocacion de excel ---*/
DEFINE VARIABLE chExcelApplication AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chWorkBook AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chWorkSheet AS COM-HANDLE NO-UNDO.
/*--- definicion de variable para la generacion del archivo ---*/
DEFINE VARIABLE cUniqueFile AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRuta AS CHARACTER NO-UNDO.
DEFINE VARIABLE cArchivo AS CHARACTER NO-UNDO.
DEFINE VARIABLE cExtension AS CHARACTER NO-UNDO.
/*--- local variable definitions ---*/
DEFINE VARIABLE picExcelFileName AS CHARACTER NO-UNDO.
DEFINE VARIABLE cColList AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRange AS CHARACTER NO-UNDO.
DEFINE VARIABLE cRow AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropEntry AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropName AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPropValue AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFontName AS CHARACTER NO-UNDO.
DEFINE VARIABLE hQueryTT AS HANDLE NO-UNDO.
DEFINE VARIABLE iRow AS INTEGER NO-UNDO.
DEFINE VARIABLE iCol AS INTEGER NO-UNDO.
DEFINE VARIABLE iPropNo AS INTEGER NO-UNDO.
DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
DEFINE VARIABLE iFontSize AS INTEGER NO-UNDO.
DEFINE VARIABLE vRow AS INTEGER INITIAL 4 NO-UNDO.
DEFINE VARIABLE cHeaderTitle AS CHARACTER NO-UNDO.
DEFINE VARIABLE cReportTitle AS CHARACTER NO-UNDO.
/*--- Validaciones ---*/
IF NOT VALID-HANDLE(pihTT) THEN
RETURN.
/*--- validacion de App Excel ---*/
CREATE "Excel.Application" chExcelApplication NO-ERROR.
IF NOT VALID-HANDLE(chExcelApplication) THEN
RETURN.
/*--- creamos el nuevo libro de trabajo ---*/
chWorkBook = chExcelApplication:Workbooks:ADD().
chWorkSheet = chWorkBook:Worksheets(1).
/*--- determinamos la version de excel para guardar archivo generado
en el formato correcto ---*/
IF INTEGER (chExcelApplication:Version) < 12 THEN
cExtension = ".xls".
ELSE
cExtension = ".xlsx".
/*--- creamos identificador unico para archivo excel ---*/
ASSIGN cUniqueFile = replace(STRING(TODAY, "99/99/9999"),"/","") + STRING(TIME).
/*--- genera propiedade del archivo excel ---*/
DO iPropNo = 1 TO NUM-ENTRIES(picProperties, '|'):
ASSIGN
cPropEntry = ENTRY(iPropNo, picProperties, '|')
iPos = INDEX(cPropEntry, '=')
cPropName = SUBSTRING(cPropEntry, 1, iPos - 1)
cPropValue = IF iPos > 0 THEN SUBSTRING(cPropEntry, iPos + 1) ELSE ''.
CASE cPropName:
WHEN 'FileName' THEN ASSIGN picExcelFileName = cPropValue.
WHEN 'PathSave' THEN ASSIGN cRuta = cPropValue.
WHEN 'HeaderTitle' THEN ASSIGN cHeaderTitle = cPropValue.
WHEN 'ReportTitle' THEN ASSIGN cReportTitle = cPropValue.
WHEN 'Font:Name' THEN ASSIGN cFontName = cPropValue.
WHEN 'Font:Size' THEN ASSIGN iFontSize = INTEGER(cPropValue) NO-ERROR.
WHEN 'PageSetup:Orientation' THEN
chWorkSheet:PageSetup:Orientation = INTEGER(cPropValue) NO-ERROR.
WHEN 'PageSetup:Zoom' THEN
chWorkSheet:PageSetup:Zoom = cPropValue.
WHEN 'PageSetup:PrintGridlines' THEN
chWorkSheet:PageSetup:PrintGridlines = CAN-DO('YES,TRUE,Y,T',cPropValue).
WHEN 'PageSetup:PrintTitleRows' THEN
chWorkSheet:PageSetup:PrintTitleRows = cPropValue.
WHEN 'PageSetup:PrintTitleColumns' THEN
chWorkSheet:PageSetup:PrintTitleColumns = cPropValue.
WHEN 'PageSetup:LeftHeader' THEN
chWorkSheet:PageSetup:LeftHeader = cPropValue.
WHEN 'PageSetup:CenterHeader' THEN
chWorkSheet:PageSetup:CenterHeader = cPropValue.
WHEN 'PageSetup:RightHeader' THEN
chWorkSheet:PageSetup:RightHeader = cPropValue.
WHEN 'PageSetup:LeftFooter' THEN
chWorkSheet:PageSetup:LeftFooter = cPropValue.
WHEN 'PageSetup:CenterFooter' THEN
chWorkSheet:PageSetup:CenterFooter = cPropValue.
WHEN 'PageSetup:RightFooter' THEN
chWorkSheet:PageSetup:RightFooter = cPropValue.
WHEN 'PageSetup:CenterHorizontally' THEN
chWorkSheet:PageSetup:CenterHorizontally = CAN-DO('YES,TRUE,Y,T',cPropValue).
WHEN 'PageSetup:CenterVertically' THEN
chWorkSheet:PageSetup:CenterVertically = CAN-DO('YES,TRUE,Y,T',cPropValue).
WHEN 'PageSetup:FitToPagesWide' THEN
chWorkSheet:PageSetup:FitToPagesWide = INTEGER(cPropValue) NO-ERROR.
WHEN 'PageSetup:FitToPagesTall' THEN
chWorkSheet:PageSetup:FitToPagesTall = INTEGER(cPropValue) NO-ERROR.
WHEN 'Visible' THEN
/*--- Mantenemos visible Excel mientras se genera el archivo ---*/
chExcelApplication:Visible = CAN-DO('YES,TRUE,Y,T',cPropValue).
END CASE. /* cPropName */
END. /* DO iPropNo = 1 TO NUM-ENTRIES(picProperties): */
/*--- establecemos fuente ---*/
IF cFontName = '' THEN
ASSIGN cFontName = "Arial Narrow".
/*--- set the column attributes for the Worksheet ---*/
ASSIGN cColList = 'A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z'
+ ',AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM'
+ ',AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ'
+ ',BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM'
+ ',BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ'
+ ',CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CM'
+ ',CN,CO,CP,CQ,CR,CS,CT,CU,CV,CW,CX,CY,CZ'
+ ',DA,DB,DC,DD,DE,DF,DG,DH,DI,DJ,DK,DL,DM'
+ ',DN,DO,DP,DQ,DR,DS,DT,DU,DV,DW,DX,DY,DZ'
+ ',EA,EB,EC,ED,EE,EF,EG,EH,EI,EJ,EK,EL,EM'
+ ',EN,EO,EP,EQ,ER,ES,ET,EU,EV,EW,EX,EY,EZ'
+ ',FA,FB,FC,FD,FE,FF,FG,FH,FI,FJ,FK,FL,FM'
+ ',FN,FO,FP,FQ,FR,FS,FT,FU,FV,FW,FX,FY,FZ'
+ ',GA,GB,GC,GD,GE,GF,GG,GH,GI,GJ,GK,GL,GM'
+ ',GN,GO,GP,GQ,GR,GS,GT,GU,GV,GW,GX,GY,GZ'.
/*--- validamos nombre de excel---*/
IF picExcelFileName <> '' THEN DO:
ASSIGN cArchivo = picExcelFileName.
END.
ELSE DO:
ASSIGN cArchivo = "ReporteGeneraExcel".
END.
IF cRuta = "" THEN
ASSIGN cRuta = "C:\tmp\".
IF cHeaderTitle <> "" THEN DO:
chWorkSheet:Range("A1:" + ENTRY(pihTT:NUM-FIELDS,cColList) + "1"):Merge.
chWorkSheet:Range("A1:" + ENTRY(pihTT:NUM-FIELDS,cColList) + "1"):HorizontalAlignment = 3.
chWorkSheet:Range("A1"):VALUE = cHeaderTitle.
chWorkSheet:Range("A1"):FONT:BOLD = TRUE.
chWorkSheet:Range("A1"):FONT:SIZE = 18.
chWorkSheet:Range("A1"):FONT:ColorIndex = 55.
END.
ELSE DO:
vRow = vRow - 2.
END.
IF cReportTitle <> "" THEN DO:
chWorkSheet:Range("A2:" + ENTRY(pihTT:NUM-FIELDS,cColList) + "2"):Merge.
chWorkSheet:Range("A2:" + ENTRY(pihTT:NUM-FIELDS,cColList) + "2"):HorizontalAlignment = 3.
chWorkSheet:Range("A2"):VALUE = cReportTitle.
chWorkSheet:Range("A2"):FONT:BOLD = TRUE.
chWorkSheet:Range("A2"):FONT:SIZE = 12.
END.
ELSE DO:
vRow = vRow - 2.
END.
/*--- Colocamos Panel fijo para titulos y nombre de columnas---*/
chWorkSheet:Rows(STRING(vRow) + ":" + STRING(vRow)):Font:Bold = TRUE.
chWorkSheet:Rows(STRING(vRow + 1) + ":" + STRING(vRow + 1)):Activate.
chExcelApplication:ActiveWindow:FreezePanes = TRUE.
/*--- construimos cabezera de columnas---*/
DO iCol = 1 TO pihTT:NUM-FIELDS:
chWorkSheet:Range(ENTRY(iCol,cColList) + STRING(vRow)):Value = pihTT:BUFFER-FIELD(iCol):LABEL.
chWorkSheet:Columns(ENTRY(iCol,cColList)):Font:Name = cFontName.
IF iFontSize > 0 THEN
chWorkSheet:Columns(ENTRY(iCol,cColList)):Font:Size = iFontSize.
IF pihTT:BUFFER-FIELD(iCol):DATA-TYPE = "DECIMAL" THEN
chWorkSheet:Columns(ENTRY(iCol,cColList)):Cells:NumberFormat = "#,###,##0.00".
ELSE IF pihTT:BUFFER-FIELD(iCol):DATA-TYPE = "CHARACTER" THEN
chWorkSheet:Columns(ENTRY(iCol,cColList)):Cells:NumberFormat = "@".
END. /* DO iCol = 1 TO pihTT:NUM-FIELDS: */
chWorkSheet:Range("A" + STRING(vRow) + ":" + ENTRY(pihTT:NUM-FIELDS,cColList) + STRING(vRow)):borders({&xlEdgeLeft}):LineStyle = {&xlContinuous}.
chWorkSheet:Range("A" + STRING(vRow) + ":" + ENTRY(pihTT:NUM-FIELDS,cColList) + STRING(vRow)):borders({&xlEdgeTop}):LineStyle = {&xlContinuous}.
chWorkSheet:Range("A" + STRING(vRow) + ":" + ENTRY(pihTT:NUM-FIELDS,cColList) + STRING(vRow)):borders({&xlEdgeBottom}):LineStyle = {&xlContinuous}.
chWorkSheet:Range("A" + STRING(vRow) + ":" + ENTRY(pihTT:NUM-FIELDS,cColList) + STRING(vRow)):borders({&xlEdgeRight}):LineStyle = {&xlContinuous}.
chWorkSheet:Range("A" + STRING(vRow) + ":" + ENTRY(pihTT:NUM-FIELDS,cColList) + STRING(vRow)):borders({&xlInsideVertical}):LineStyle = {&xlContinuous}.
/*
pintamos contenido de la tabla temporal
*/
/*--- set the query ---*/
CREATE QUERY hQueryTT.
hQueryTT:SET-BUFFERS(pihTT).
hQueryTT:QUERY-PREPARE("FOR EACH " + pihTT:NAME).
hQueryTT:QUERY-OPEN.
ASSIGN iRow = vRow.
REPEAT:
hQueryTT:GET-NEXT.
IF hQueryTT:QUERY-OFF-END THEN LEAVE.
ASSIGN iRow = iRow + 1
cRow = STRING(iRow).
DO iCol = 1 TO pihTT:NUM-FIELDS:
chWorkSheet:Range(ENTRY(iCol,cColList) + cRow):Value = pihTT:BUFFER-FIELD(iCol):BUFFER-VALUE.
END.
END. /* REPEAT: */
hQueryTT:QUERY-CLOSE.
DELETE OBJECT hQueryTT.
chWorkSheet:PageSetup:CenterHorizontally = TRUE.
chWorkSheet:PageSetup:BottomMargin = chExcelApplication:InchesToPoints(0.42).
chWorkSheet:PageSetup:Zoom = 90.
chWorkSheet:PageSetup:ORIENTATION = 2.
chWorkSheet:pagesetup:PrintTitleRows = "$1:$" + STRING(vRow) .
chWorkSheet:Range('A:' + ENTRY(pihTT:NUM-FIELDS,cColList) ):EntireColumn:AutoFit().
chExcelApplication:DisplayAlerts = FALSE.
chWorkBook:SaveAs( cRuta + cArchivo + "_" + cUniqueFile + cExtension,,,,,,,).
IF VALID-HANDLE(chWorkSheet) THEN
RELEASE OBJECT chWorkSheet.
IF VALID-HANDLE(chWorkBook) THEN
RELEASE OBJECT chWorkBook.
IF VALID-HANDLE(chExcelApplication) THEN
RELEASE OBJECT chExcelApplication.
MESSAGE "Generacion de Excel Terminada. " SKIP(1)
"Directorio: " cRuta SKIP
"Nombre Excel: " (cArchivo + "_" + cUniqueFile + cExtension)
VIEW-AS ALERT-BOX INFO BUTTONS OK.
Bitacora 