Tema: Exportar para o Excel con colores
Ver Mensaje Individual
  #4
Antiguo 23 de agosto de 2023, 12:41
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 02.10.2026 10:24
Posts Posts: 404
Likes enviados Enviados: 130
Likes recibidos Recibidos: 180
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Joseg Ver Mensaje
❞
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.
Joseg is offline   Responder Con Cita