Cobol Foro

Cobol Foro (https://www.cobolforo.es/index.php)
-   PowerCOBOL (ActiveX, v4 - v11) (https://www.cobolforo.es/forumdisplay.php?f=9)
-   -   [Compilador] Exportar para o Excel con colores (https://www.cobolforo.es/showthread.php?t=1666)

Joseg 22 de agosto de 2023 19:39
Exportar para o Excel con colores
 
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:
Código COBOL:
  1.             PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
  2.             IF "Width" OF "TableColumns"(IDX2) OF Table2 > 5     
  3.                   MOVE "Text" OF "TableCells"(0 IDX2) OF Table2 TO VAL   
  4.                   MOVE  WSLONG TO ARRAY-ROW    MOVE IDX5 TO ARRAY-COL
  5.                   INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL
  6.                         RETURNING CELL
  7.                   INVOKE CELL "SET-VALUE" USING VAL
  8.                   INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR    *> CORES TITULOS DAS COLUNAS
  9.                   INVOKE INTERIOR "SET-COLOR" USING WCOLOR
  10.                   ADD 1                             TO IDX5
  11.                  END-IF
  12.             END-PERFORM.


Detalle:

Código COBOL:
  1.              PERFORM VARYING IDX4 FROM 1 BY 1 UNTIL IDX4 > IDX2
  2.                  IF "Width" OF "TableColumns"(IDX4) OF Table2 > 5   
  3.                        MOVE "Text" OF "TableCells"(IDX3 IDX4) OF Table2 TO LINHA  
  4.                   
  5.                        INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
  6.                        MOVE "BackColor" OF "TableCells"(IDX3 IDX4) OF Table2 TO WCOLOR2
  7.                        INVOKE XXXXX  "GET-INTERIOR" RETURNING INTERIOR      *> ??????????????????
  8.                        INVOKE INTERIOR "SET-COLOR" USING WCOLOR2
  9.                        ADD 1 TO IDX5
  10.                   END-IF

Alguien sabe como hacerlo?
Gracias

fastpho 22 de agosto de 2023 20:53
Hola @Joseg , link de colores *>https://learn.microsoft.com/en-us/of...cel.colorindex permitidos
Primer posicionar fila,columna , luego seleccionarla , luego enviar el color

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  *>[url]https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex[/url]
  5.  *> propiedad 
  6.  01 COLOR-INDEX          PIC S9(9) comp-5. *>colores van de 1 to 56.
  7.  PROCEDURE       DIVISION.
  8.  
  9.         MOVE 1 TO ARRAY-ROW.
  10.         MOVE 1 TO ARRAY-COL. 
  11.           INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
  12.           INVOKE CELL "SELECT" 
  13.           MOVE 26 TO COLOR-INDEX.
  14.           INVOKE CELL         "GET-FONT"  RETURNING DOCFONT
  15.           INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX
  16.  
  17.  
  18.         MOVE 2 TO ARRAY-ROW.
  19.         MOVE 2 TO ARRAY-COL. 
  20.           INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
  21.           INVOKE CELL "SELECT" 
  22.           MOVE 26 TO COLOR-INDEX.
  23.           INVOKE CELL         "GET-INTERIOR"  RETURNING DOCFONT
  24.           INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX
Saludos...

Joseg 22 de agosto de 2023 23:16
Cita:
Citación del post de fastpho (Mensaje 9051)
Hola @Joseg , link de colores *>https://learn.microsoft.com/en-us/of...cel.colorindex permitidos
Primer posicionar fila,columna , luego seleccionarla , luego enviar el color

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  *>[url]https://learn.microsoft.com/en-us/office/vba/api/excel.colorindex[/url]
  5.  *> propiedad 
  6.  01 COLOR-INDEX          PIC S9(9) comp-5. *>colores van de 1 to 56.
  7.  PROCEDURE       DIVISION.
  8.  
  9.         MOVE 1 TO ARRAY-ROW.
  10.         MOVE 1 TO ARRAY-COL. 
  11.           INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
  12.           INVOKE CELL "SELECT" 
  13.           MOVE 26 TO COLOR-INDEX.
  14.           INVOKE CELL         "GET-FONT"  RETURNING DOCFONT
  15.           INVOKE DOCFONT "SET-ColorIndex" USING COLOR-INDEX
  16.  
  17.  
  18.         MOVE 2 TO ARRAY-ROW.
  19.         MOVE 2 TO ARRAY-COL. 
  20.           INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
  21.           INVOKE CELL "SELECT" 
  22.           MOVE 26 TO COLOR-INDEX.
  23.           INVOKE CELL         "GET-INTERIOR"  RETURNING DOCFONT
  24.           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:
Código COBOL:
  1. MOVE "BackColor" OF "TableCells" (IDX3 IDX4) OF Table TO WCOLOR
  2. INVOKE INTERIOR "SET-COLOR" USING WCOLOR
o
Código COBOL:
  1. MOVE POW-COLOR-RED TO WCOLOR
  2. 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 23 de agosto de 2023 12:41
Cita:
Citación del post de Joseg (Mensaje 9052)
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:
Código COBOL:
  1. MOVE "BackColor" OF "TableCells" (IDX3 IDX4) OF Table TO WCOLOR
  2. INVOKE INTERIOR "SET-COLOR" USING WCOLOR
o
Código COBOL:
  1. MOVE POW-COLOR-RED TO WCOLOR
  2. 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)
Código COBOL:
  1. *
  2.  ENVIRONMENT DIVISION.
  3.  DATA            DIVISION.
  4.  WORKING-STORAGE SECTION.
  5.  01 WSLONG                  PIC S9(9) COMP-5 VALUE 0.
  6.  01 IDX1                    PIC S9(9) COMP-5 VALUE 0.
  7.  01 IDX2                    PIC S9(9) COMP-5 VALUE 0.
  8.  01 IDX3                    PIC S9(9) COMP-5 VALUE 0.
  9.  01 IDX33                   PIC S9(9) COMP-5 VALUE 0.
  10.  
  11.  01 IDX4                    PIC S9(9) COMP-5 VALUE 0.
  12.  01 IDX5                    PIC S9(9) COMP-5 VALUE 0.
  13.  01 IDX6                    PIC S9(9) COMP-5 VALUE 0.
  14.  
  15.  01  WCOLOR                 PIC 9(009)   COMP-5.
  16.  01  WCOLOR2                PIC 9(009)   COMP-5.
  17.  
  18.  01  EXCEL              OBJECT REFERENCE OLE.
  19.  01  WORKBOOK           OBJECT REFERENCE OLE.
  20.  01  SHEETS             OBJECT REFERENCE OLE.
  21.  01  WORKSHEET          OBJECT REFERENCE OLE.
  22.  01  CELL               OBJECT REFERENCE OLE.
  23.  01  COLUMNS            OBJECT REFERENCE OLE.
  24.  01  WCOLUMN            OBJECT REFERENCE OLE.
  25.  01  OBJRANGE           OBJECT REFERENCE OLE.
  26.  01  FITRANGE           OBJECT REFERENCE OLE.
  27.  01  INTERIOR           OBJECT REFERENCE OLE.
  28. *
  29.  01 ARRAYOBJ OBJECT REFERENCE COM-ARRAY.
  30.  01 LONG-INT-TYPE           PIC S9(9) COMP-5 VALUE 12.
  31.  01 ARRAY-DIMENSION         PIC S9(9) COMP-5 VALUE 2.
  32.  01 AXIS-1                  PIC S9(9) COMP-5 VALUE 22.
  33.  01 AXIS-2                  PIC S9(9) COMP-5 VALUE 22.
  34. *
  35.  01  APPLICATION                    PIC X(20) VALUE "EXCEL.APPLICATION".
  36.  01  OLE-TRUE                       PIC 1(1)  BIT VALUE B"1".
  37.  01  FILLER                         PIC 1(7)  BIT.        
  38.  01  OLE-FALSE                      PIC 1(1)  BIT VALUE B"0".
  39.  01  FILLER                         PIC 1(7)  BIT.        
  40.  01  ARRAY-ROW                      PIC S9(9) COMP-5.
  41.  01  ARRAY-COL                      PIC S9(9) COMP-5.
  42.  01  VAL                            PIC X(256).
  43.  01  S-INDEX                        PIC S9(4) COMP-5 VALUE 1.
  44.  01  LINHA                          PIC X(1024).
  45.  01  OLE-ERR-METHOD                 PIC X(256).
  46.  01  OLE-ERR-INFO.                                                
  47.      03  OLE-ERR-TYPE           PIC X(001).                          
  48.      03  OLE-ERR-WCODE          PIC X(002).                          
  49.      03  ROLE-ERR-WCODE REDEFINES OLE-ERR-WCODE  PIC S9(04) COMP-5.
  50.      03  OLE-ERR-SCODE          PIC X(004).                          
  51.      03  ROLE-ERR-SCODE REDEFINES OLE-ERR-SCODE PIC S9(09) COMP-5.
  52. *
  53.  01  XARRCOL                 PIC X(026)  VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
  54.  01  ARRCOLS  REDEFINES XARRCOL.
  55.      03   ARRCOL    OCCURS 26   PIC X(001).
  56. *
  57.  01  FORMATNUM               PIC X(9)  VALUE "#.##0,00".       
  58.  01  FORMATDATE              PIC X(12) VALUE "aaaa-mm-dd".
  59.  01  NRCOLS                  PIC S9(9) COMP-5   VALUE 1.
  60.  01  INIROW                  PIC S9(9) COMP-5   VALUE 2.
  61.  01  INICOL                  PIC S9(9) COMP-5   VALUE 1.
  62.  01  ENDROW                  PIC S9(9) COMP-5   VALUE 2.
  63.  01  ENDCOL                  PIC S9(9) COMP-5   VALUE 22.
  64.  01  INIRANGE                PIC X(19)          VALUE " A0000002: Z0000002".
  65.  01  ROWVAL                  PIC 9(007).
  66.  01  COLVAL                  PIC 9(007).
  67.  01  PICSTRING               PIC X(020).
  68.  01  PICDATE                 PIC X(10).
  69.  PROCEDURE DIVISION.
  70.  DECLARATIVES.                                              
  71.  OLE-ERRO SECTION.                                          
  72.                      
  73.        USE AFTER EXCEPTION OLE-EX.                           
  74.        INVOKE EXCEPTION-OBJECT "GET-ERROR-TYPE"
  75.          RETURNING OLE-ERR-TYPE.
  76.            IF OLE-ERR-TYPE = "1"
  77.               INVOKE EXCEPTION-OBJECT "GET-SCODE" RETURNING ROLE-ERR-SCODE
  78.               INVOKE EXCEPTION-OBJECT "GET-SCODE-TEXT" RETURNING LINHA
  79.               MOVE LINHA TO OLE-ERR-METHOD
  80.               GO TO MAIN-99
  81.            ELSE
  82.               INVOKE EXCEPTION-OBJECT "GET-WCODE" RETURNING OLE-ERR-WCODE
  83.               INVOKE EXCEPTION-OBJECT "GET-SCODE" RETURNING OLE-ERR-SCODE
  84.               GO TO MAIN-99.
  85.   END DECLARATIVES.
  86. *
  87.   MAIN SECTION.
  88.   MAIN-00.                                          
  89.       IF "RowCount" OF Table2 = ZERO GO TO MAIN-99.
  90.       MOVE POW-COLOR-GRAY                  TO WCOLOR 
  91.       MOVE 11                              TO "MousePointer" OF POW-SELF.
  92.       MOVE 1                               TO WSLONG.
  93.       MOVE 1                               TO S-INDEX.
  94.       INVOKE OLE "CREATE-OBJECT" USING APPLICATION RETURNING EXCEL.
  95.       INVOKE EXCEL "GET-WORKBOOKS" RETURNING WORKBOOK.
  96.       INVOKE WORKBOOK "ADD"                 RETURNING WORKBOOK.
  97.       INVOKE WORKBOOK "GET-WORKSHEETS" RETURNING SHEETS.
  98.       INVOKE SHEETS   "GET-ITEM" USING S-INDEX   RETURNING WORKSHEET.
  99. *
  100.       MOVE "ColumnCount" OF Table2    TO IDX1.
  101. *
  102.             MOVE 1                               TO IDX5.
  103.             PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
  104. *           IF "Width" OF "TableColumns"(IDX2) OF Table2 > 1    *> ScaleMode "0 - Pixels" 
  105.                   MOVE "Text" OF "TableCells"(0 IDX2) OF Table2 TO VAL   
  106.                   MOVE  WSLONG TO ARRAY-ROW    MOVE IDX5 TO ARRAY-COL
  107.                   INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL RETURNING CELL
  108.                   INVOKE CELL "SET-VALUE" USING VAL
  109.                   INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR    
  110.                   INVOKE INTERIOR "SET-COLOR" USING WCOLOR       *> CORES TITULOS DAS COLUNAS - "POW-COLOR-GRAY"
  111.                   ADD 1                             TO IDX5
  112. *           END-IF
  113.             END-PERFORM.
  114. *
  115.             ADD 1                                TO WSLONG.
  116.             MOVE "RowCount" OF Table2          TO IDX1.
  117.             MOVE "ColumnCount" OF Table2    TO IDX2.
  118. *
  119.             MOVE IDX1 TO AXIS-1.
  120.             MOVE IDX2 TO AXIS-2.
  121.             INVOKE COM-ARRAY "NEW" USING LONG-INT-TYPE ARRAY-DIMENSION AXIS-1
  122.                                   AXIS-2 RETURNING ARRAYOBJ.
  123.       INVOKE POW-SELF "THRUEVENTS".
  124. *
  125. * CARREGAR O ARRAY BIDINENSIONAL OLE-ARRAY A PARTIR DA LISTVIEW
  126. *
  127.       PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > IDX1
  128.         MOVE 1 TO IDX5
  129.              PERFORM VARYING IDX4 FROM 1 BY 1 UNTIL IDX4 > IDX2
  130. *                IF "Width" OF "TableColumns"(IDX4) OF Table2 > 1  *> ScaleMode "0 - Pixels"   
  131.                        MOVE "Text" OF "TableCells"(IDX3 IDX4) OF Table2 TO LINHA  
  132.                        INSPECT LINHA REPLACING ALL "+000000,0 " BY "          "
  133.                        INSPECT LINHA REPLACING ALL "+00000000 " BY "          "                        
  134.                        INSPECT LINHA REPLACING ALL "+000000   " BY "          "                        
  135.                        INSPECT LINHA REPLACING ALL "+00 "       BY "    "
  136.                        INSPECT LINHA REPLACING ALL "+0  "       BY "    "
  137.                        INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
  138.                        ADD 1 TO IDX5
  139. *####
  140.                        COMPUTE IDX33 = IDX3 + 1
  141.                        MOVE "BackColor" OF "TableCells"(IDX3 IDX4) OF Table2 TO WCOLOR2
  142.                        INVOKE WORKSHEET "GET-CELLS" USING IDX33 IDX4 RETURNING CELL
  143.                        INVOKE CELL "GET-INTERIOR" RETURNING INTERIOR
  144.                        INVOKE INTERIOR "SET-COLOR" USING WCOLOR2
  145. *####                  
  146. *                 END-IF
  147.              END-PERFORM
  148.          IF IDX3 = 5000 OR = 10000 OR = 15000 OR = 20000 OR = 250000 OR = 30000
  149.                         OR = 35000 OR = 40000
  150.                     INVOKE POW-SELF "THRUEVENTS"
  151.          END-IF
  152.       END-PERFORM.
  153. *
  154. *******  CALCULAR O "RANGE" DA FOLHA TODA PARA ENVIAR O ARRAY DUMA SO VEZ
  155. *PRIMEIRA CELULA É SEMPRE "A00002"
  156.       MOVE 1    TO ROWVAL ADD 1 TO ROWVAL  MOVE ROWVAL TO INIRANGE(3:7).
  157.       IF IDX2 < 27 
  158.            MOVE " "          TO INIRANGE(11:1)
  159.            MOVE ARRCOL(IDX2) TO INIRANGE(12:1)
  160.         ELSE
  161.            SUBTRACT 26 FROM IDX2 GIVING COLVAL
  162.            MOVE "A"          TO INIRANGE(11:1)
  163.            MOVE ARRCOL(COLVAL) TO INIRANGE(12:1)
  164.       END-IF.
  165.       MOVE IDX1 TO ROWVAL ADD 1 TO ROWVAL.
  166.       MOVE ROWVAL TO INIRANGE(13:7).
  167.       INVOKE WORKSHEET "GET-RANGE" USING INIRANGE RETURNING OBJRANGE.
  168.       INVOKE OBJRANGE "SET-VALUE" USING ARRAYOBJ.
  169. *
  170.  MAIN-80.
  171. *
  172. *IZANDO O RANGE QUE FOI DAS COLUNAS/LINHAS UTILIZADAS VAI FAZER O AUTOFIT (ALARGAR AS COLUNAS)
  173. *
  174.         INVOKE WORKSHEET   "GET-USEDRANGE"       RETURNING OBJRANGE.
  175.         INVOKE OBJRANGE "GET-ENTIRECOLUMN" RETURNING FITRANGE.
  176.         INVOKE FITRANGE "AUTOFIT".
  177.         MOVE 0 TO "MousePointer" OF POW-SELF.
  178. *TRUIR OS OBJECTOS UTILIZADOS PARA LIBERTAR MEMORIA
  179.         INVOKE EXCEL "SET-VISIBLE" USING OLE-TRUE.
  180.         INVOKE EXCEL "QUIT".
  181.         SET CELL      TO NULL.
  182.         SET COLUMNS   TO NULL.
  183.         SET FITRANGE  TO NULL.
  184.         SET OBJRANGE  TO NULL.
  185.         SET WORKSHEET TO NULL.
  186.         SET SHEETS    TO NULL.
  187.         SET WORKBOOK  TO NULL.
  188.         SET EXCEL     TO NULL.
  189.   MAIN-99.
  190.         MOVE 0 TO "MousePointer" OF POW-SELF.
  191.         EXIT PROGRAM.


La franja horaria es GMT +2. Ahora son las 04:56.

Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2026, Jelsoft Enterprises Ltd.