Cobol Foro
Navegación en el Foro
Retroceder   Cobol Foro Entornos de desarrollo y compiladores Cobol Fujitsu COBOL PowerCOBOL (ActiveX, v4 - v11)
PowerCOBOL (ActiveX, v4 - v11) Versiones del IDE basadas en ActiveX
 
Otros temas que te pueden interesar
Tema Autor Foro Respuestas Último post
Exportar informacion desde un archivo a Excel Roberto PowerCOBOL (ActiveX, v4 - v11) 0 20 de agosto de 2023 15:46
[PowerCOBOL + WinAPI] ListView con Colores Josber Cocina PowerCOBOL 12 11 de enero de 2023 15:39
[Duda] Exportar a Excel Roger PowerCOBOL y COM/OLE 11 5 de mayo de 2020 20:43
[Sintaxis] Exportar Reporte a Excel jmeza Fujitsu COBOL 4 7 de julio de 2018 19:29
[PowerCOBOL + COM/OLE] Exportar CmListview en Excel Rapinto Cocina PowerCOBOL 0 25 de febrero de 2015 23:31

Respuesta

  #1
Antiguo 22 de agosto de 2023, 19:39
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 Exportar para o Excel con colores
0 Inactivo Inactivo

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
Joseg is offline   Responder Con Cita
  #2
Antiguo 22 de agosto de 2023, 20:53
fastpho
El Foro es mi casa
Innovación: Por aportar innovaciones - Issue reason: SQLite + OO Cobol class Concurso: Primer puesto: Ganador/a del Primer puesto en un concurso - Issue reason: Acceso a datos Cobol vía web 
Última Actividad 30.09.2026 19:12
Posts Posts: 365
Likes enviados Enviados: 252
Likes recibidos Recibidos: 243

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...
fastpho is offline   Responder Con Cita
  #3
Antiguo 22 de agosto de 2023, 23:16
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

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

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
Respuesta


Herramientas

Derechos de Publicación
No puedes publicar nuevos temas
No puedes publicar posts/responder
No puedes adjuntar archivos
No puedes editar tus posts

BB code is habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado

Saltar a Foro


La franja horaria es GMT +2. Ahora son las 06:34.
Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2026, Jelsoft Enterprises Ltd.