Exportar para o Excel con colores

[Joseg]

Me gustaría exportar una Tabla para Excel con los colores de las respectivas celdas.
Poner los colores en los títulos de las columnas es fácil, pero no entiendo los detalles de cómo se envía una serie de datos.

Código tem por base o exemplo do saudoso "RAPINTO".

Títulos de columna:

PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
IF "Width" OF "TableColumns"(IDX2) OF Table2 > 5
MOVE "Text" OF "TableCells"(0 IDX2) OF Table2 TO VAL
MOVE WSLONG TO ARRAY-ROW MOVE IDX5 TO ARRAY-COL
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL
RETURNING CELL
INVOKE CELL "SET-VALUE" USING VAL
INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR *> CORES TITULOS DAS COLUNAS
INVOKE INTERIOR "SET-COLOR" USING WCOLOR
ADD 1 TO IDX5
END-IF
END-PERFORM.




Detalle:


PERFORM VARYING IDX4 FROM 1 BY 1 UNTIL IDX4 > IDX2
IF "Width" OF "TableColumns"(IDX4) OF Table2 > 5
MOVE "Text" OF "TableCells"(IDX3 IDX4) OF Table2 TO LINHA

INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
MOVE "BackColor" OF "TableCells"(IDX3 IDX4) OF Table2 TO WCOLOR2
INVOKE XXXXX "GET-INTERIOR" RETURNING INTERIOR *> ??????????????????
INVOKE INTERIOR "SET-COLOR" USING WCOLOR2
ADD 1 TO IDX5
END-IF


Alguien sabe como hacerlo?
Gracias

[fastpho]

Hola @Joseg , link de colores *>https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex permitidos
Primer posicionar fila,columna , luego seleccionarla , luego enviar el color


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*>https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex
*> propiedad
01 COLOR-INDEX PIC S9(9) comp-5. *>colores van de 1 to 56.
PROCEDURE DIVISION.

MOVE 1 TO ARRAY-ROW.
MOVE 1 TO ARRAY-COL.
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
INVOKE CELL "SELECT"
MOVE 26 TO COLOR-INDEX.
INVOKE CELL "GET-FONT" RETURNING DOCFONT
INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX


MOVE 2 TO ARRAY-ROW.
MOVE 2 TO ARRAY-COL.
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
INVOKE CELL "SELECT"
MOVE 26 TO COLOR-INDEX.
INVOKE CELL "GET-INTERIOR" RETURNING DOCFONT
INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX


Saludos...

[Joseg]

Hola @Joseg , link de colores *>https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex permitidos
Primer posicionar fila,columna , luego seleccionarla , luego enviar el color


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*>https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex
*> propiedad
01 COLOR-INDEX PIC S9(9) comp-5. *>colores van de 1 to 56.
PROCEDURE DIVISION.

MOVE 1 TO ARRAY-ROW.
MOVE 1 TO ARRAY-COL.
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
INVOKE CELL "SELECT"
MOVE 26 TO COLOR-INDEX.
INVOKE CELL "GET-FONT" RETURNING DOCFONT
INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX


MOVE 2 TO ARRAY-ROW.
MOVE 2 TO ARRAY-COL.
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
INVOKE CELL "SELECT"
MOVE 26 TO COLOR-INDEX.
INVOKE CELL "GET-INTERIOR" RETURNING DOCFONT
INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX


Saludos...

Gracias.
Sé cómo cambiar los colores, pero quería implementar este cambio usando el color de fondo de una celda de la tabla powercobol en el ejemplo de RAPINTO que exporta una Listview (o tabla) a Excel (todas las filas columnas).
Por cierto, "SET-ColorIndex" se usa con números de color, como dices, pero podemos usar "SET-COLOR".

Exemplo:

MOVE "BackColor" OF "TableCells" (IDX3 IDX4) OF Table TO WCOLOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR

o

MOVE POW-COLOR-RED TO WCOLOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR


En otras palabras, quiero exportar todo el contenido de una tabla (hasta 2000 líneas), con muchas celdas de diferentes colores. Quiero exportar a Excel exactamente como se ve en la pantalla.

[Joseg]

Gracias.
Sé cómo cambiar los colores, pero quería implementar este cambio usando el color de fondo de una celda de la tabla powercobol en el ejemplo de RAPINTO que exporta una Listview (o tabla) a Excel (todas las filas columnas).
Por cierto, "SET-ColorIndex" se usa con números de color, como dices, pero podemos usar "SET-COLOR".

Exemplo:

MOVE "BackColor" OF "TableCells" (IDX3 IDX4) OF Table TO WCOLOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR

o

MOVE POW-COLOR-RED TO WCOLOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR


En otras palabras, quiero exportar todo el contenido de una tabla (hasta 2000 líneas), con muchas celdas de diferentes colores. Quiero exportar a Excel exactamente como se ve en la pantalla.






Ya tengo un código que funciona, sólo que no puedo eliminar las columnas "ocultas"
("Width" OF "TableColumns"(IDX2) OF Table2 =0)

*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WSLONG PIC S9(9) COMP-5 VALUE 0.
01 IDX1 PIC S9(9) COMP-5 VALUE 0.
01 IDX2 PIC S9(9) COMP-5 VALUE 0.
01 IDX3 PIC S9(9) COMP-5 VALUE 0.
01 IDX33 PIC S9(9) COMP-5 VALUE 0.

01 IDX4 PIC S9(9) COMP-5 VALUE 0.
01 IDX5 PIC S9(9) COMP-5 VALUE 0.
01 IDX6 PIC S9(9) COMP-5 VALUE 0.

01 WCOLOR PIC 9(009) COMP-5.
01 WCOLOR2 PIC 9(009) COMP-5.

01 EXCEL OBJECT REFERENCE OLE.
01 WORKBOOK OBJECT REFERENCE OLE.
01 SHEETS OBJECT REFERENCE OLE.
01 WORKSHEET OBJECT REFERENCE OLE.
01 CELL OBJECT REFERENCE OLE.
01 COLUMNS OBJECT REFERENCE OLE.
01 WCOLUMN OBJECT REFERENCE OLE.
01 OBJRANGE OBJECT REFERENCE OLE.
01 FITRANGE OBJECT REFERENCE OLE.
01 INTERIOR OBJECT REFERENCE OLE.
*
01 ARRAYOBJ OBJECT REFERENCE COM-ARRAY.
01 LONG-INT-TYPE PIC S9(9) COMP-5 VALUE 12.
01 ARRAY-DIMENSION PIC S9(9) COMP-5 VALUE 2.
01 AXIS-1 PIC S9(9) COMP-5 VALUE 22.
01 AXIS-2 PIC S9(9) COMP-5 VALUE 22.
*
01 APPLICATION PIC X(20) VALUE "EXCEL.APPLICATION".
01 OLE-TRUE PIC 1(1) BIT VALUE B"1".
01 FILLER PIC 1(7) BIT.
01 OLE-FALSE PIC 1(1) BIT VALUE B"0".
01 FILLER PIC 1(7) BIT.
01 ARRAY-ROW PIC S9(9) COMP-5.
01 ARRAY-COL PIC S9(9) COMP-5.
01 VAL PIC X(256).
01 S-INDEX PIC S9(4) COMP-5 VALUE 1.
01 LINHA PIC X(1024).
01 OLE-ERR-METHOD PIC X(256).
01 OLE-ERR-INFO.
03 OLE-ERR-TYPE PIC X(001).
03 OLE-ERR-WCODE PIC X(002).
03 ROLE-ERR-WCODE REDEFINES OLE-ERR-WCODE PIC S9(04) COMP-5.
03 OLE-ERR-SCODE PIC X(004).
03 ROLE-ERR-SCODE REDEFINES OLE-ERR-SCODE PIC S9(09) COMP-5.
*
01 XARRCOL PIC X(026) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
01 ARRCOLS REDEFINES XARRCOL.
03 ARRCOL OCCURS 26 PIC X(001).
*
01 FORMATNUM PIC X(9) VALUE "#.##0,00".
01 FORMATDATE PIC X(12) VALUE "aaaa-mm-dd".
01 NRCOLS PIC S9(9) COMP-5 VALUE 1.
01 INIROW PIC S9(9) COMP-5 VALUE 2.
01 INICOL PIC S9(9) COMP-5 VALUE 1.
01 ENDROW PIC S9(9) COMP-5 VALUE 2.
01 ENDCOL PIC S9(9) COMP-5 VALUE 22.
01 INIRANGE PIC X(19) VALUE " A0000002: Z0000002".
01 ROWVAL PIC 9(007).
01 COLVAL PIC 9(007).
01 PICSTRING PIC X(020).
01 PICDATE PIC X(10).
PROCEDURE DIVISION.
DECLARATIVES.
OLE-ERRO SECTION.

USE AFTER EXCEPTION OLE-EX.
INVOKE EXCEPTION-OBJECT "GET-ERROR-TYPE"
RETURNING OLE-ERR-TYPE.
IF OLE-ERR-TYPE = "1"
INVOKE EXCEPTION-OBJECT "GET-SCODE" RETURNING ROLE-ERR-SCODE
INVOKE EXCEPTION-OBJECT "GET-SCODE-TEXT" RETURNING LINHA
MOVE LINHA TO OLE-ERR-METHOD
GO TO MAIN-99
ELSE
INVOKE EXCEPTION-OBJECT "GET-WCODE" RETURNING OLE-ERR-WCODE
INVOKE EXCEPTION-OBJECT "GET-SCODE" RETURNING OLE-ERR-SCODE
GO TO MAIN-99.
END DECLARATIVES.
*
MAIN SECTION.
MAIN-00.
IF "RowCount" OF Table2 = ZERO GO TO MAIN-99.
MOVE POW-COLOR-GRAY TO WCOLOR
MOVE 11 TO "MousePointer" OF POW-SELF.
MOVE 1 TO WSLONG.
MOVE 1 TO S-INDEX.
INVOKE OLE "CREATE-OBJECT" USING APPLICATION RETURNING EXCEL.
INVOKE EXCEL "GET-WORKBOOKS" RETURNING WORKBOOK.
INVOKE WORKBOOK "ADD" RETURNING WORKBOOK.
INVOKE WORKBOOK "GET-WORKSHEETS" RETURNING SHEETS.
INVOKE SHEETS "GET-ITEM" USING S-INDEX RETURNING WORKSHEET.
*
MOVE "ColumnCount" OF Table2 TO IDX1.
*
MOVE 1 TO IDX5.
PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
* IF "Width" OF "TableColumns"(IDX2) OF Table2 > 1 *> ScaleMode "0 - Pixels"
MOVE "Text" OF "TableCells"(0 IDX2) OF Table2 TO VAL
MOVE WSLONG TO ARRAY-ROW MOVE IDX5 TO ARRAY-COL
INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
INVOKE CELL "SET-VALUE" USING VAL
INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR *> CORES TITULOS DAS COLUNAS - "POW-COLOR-GRAY"
ADD 1 TO IDX5
* END-IF
END-PERFORM.
*
ADD 1 TO WSLONG.
MOVE "RowCount" OF Table2 TO IDX1.
MOVE "ColumnCount" OF Table2 TO IDX2.
*
MOVE IDX1 TO AXIS-1.
MOVE IDX2 TO AXIS-2.
INVOKE COM-ARRAY "NEW" USING LONG-INT-TYPE ARRAY-DIMENSION AXIS-1
AXIS-2 RETURNING ARRAYOBJ.
INVOKE POW-SELF "THRUEVENTS".
*
* CARREGAR O ARRAY BIDINENSIONAL OLE-ARRAY A PARTIR DA LISTVIEW
*
PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > IDX1
MOVE 1 TO IDX5
PERFORM VARYING IDX4 FROM 1 BY 1 UNTIL IDX4 > IDX2
* IF "Width" OF "TableColumns"(IDX4) OF Table2 > 1 *> ScaleMode "0 - Pixels"
MOVE "Text" OF "TableCells"(IDX3 IDX4) OF Table2 TO LINHA
INSPECT LINHA REPLACING ALL "+000000,0 " BY " "
INSPECT LINHA REPLACING ALL "+00000000 " BY " "
INSPECT LINHA REPLACING ALL "+000000 " BY " "
INSPECT LINHA REPLACING ALL "+00 " BY " "
INSPECT LINHA REPLACING ALL "+0 " BY " "
INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
ADD 1 TO IDX5
*####
COMPUTE IDX33 = IDX3 + 1
MOVE "BackColor" OF "TableCells"(IDX3 IDX4) OF Table2 TO WCOLOR2
INVOKE WORKSHEET "GET-CELLS" USING IDX33 IDX4 RETURNING CELL
INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR
INVOKE INTERIOR "SET-COLOR" USING WCOLOR2
*####
* END-IF
END-PERFORM
IF IDX3 = 5000 OR = 10000 OR = 15000 OR = 20000 OR = 250000 OR = 30000
OR = 35000 OR = 40000
INVOKE POW-SELF "THRUEVENTS"
END-IF
END-PERFORM.
*
******* CALCULAR O "RANGE" DA FOLHA TODA PARA ENVIAR O ARRAY DUMA SO VEZ
*PRIMEIRA CELULA É SEMPRE "A00002"
MOVE 1 TO ROWVAL ADD 1 TO ROWVAL MOVE ROWVAL TO INIRANGE(3:7).
IF IDX2 < 27
MOVE " " TO INIRANGE(11:1)
MOVE ARRCOL(IDX2) TO INIRANGE(12:1)
ELSE
SUBTRACT 26 FROM IDX2 GIVING COLVAL
MOVE "A" TO INIRANGE(11:1)
MOVE ARRCOL(COLVAL) TO INIRANGE(12:1)
END-IF.
MOVE IDX1 TO ROWVAL ADD 1 TO ROWVAL.
MOVE ROWVAL TO INIRANGE(13:7).
INVOKE WORKSHEET "GET-RANGE" USING INIRANGE RETURNING OBJRANGE.
INVOKE OBJRANGE "SET-VALUE" USING ARRAYOBJ.
*
MAIN-80.
*
*IZANDO O RANGE QUE FOI DAS COLUNAS/LINHAS UTILIZADAS VAI FAZER O AUTOFIT (ALARGAR AS COLUNAS)
*
INVOKE WORKSHEET "GET-USEDRANGE" RETURNING OBJRANGE.
INVOKE OBJRANGE "GET-ENTIRECOLUMN" RETURNING FITRANGE.
INVOKE FITRANGE "AUTOFIT".
MOVE 0 TO "MousePointer" OF POW-SELF.
*TRUIR OS OBJECTOS UTILIZADOS PARA LIBERTAR MEMORIA
INVOKE EXCEL "SET-VISIBLE" USING OLE-TRUE.
INVOKE EXCEL "QUIT".
SET CELL TO NULL.
SET COLUMNS TO NULL.
SET FITRANGE TO NULL.
SET OBJRANGE TO NULL.
SET WORKSHEET TO NULL.
SET SHEETS TO NULL.
SET WORKBOOK TO NULL.
SET EXCEL TO NULL.
MAIN-99.
MOVE 0 TO "MousePointer" OF POW-SELF.
EXIT PROGRAM.