Gracias Rui Pinto (Rapinto)
COBOL Foro
Foro dedicado a COBOL, a la Programación y a la Informática.
Retroceder   COBOL Foro > IDE-s y compiladores COBOL > Cocina Casera > Cocina PowerCOBOL + COM/OLE
Cocina PowerCOBOL + COM/OLE Código PowerCOBOL en utilización con OLE/COM
Comunicados
Otros temas que te pueden interesar
Tema Autor Foro Respuestas Último post
[Aporte] Manejo de control CmListView (Grid) Josber Cocina PowerCOBOL 27 18 de noviembre de 2019 09:16
[Sintaxis] Exportar Reporte a Excel jmeza Fujitsu COBOL 4 7 de julio de 2018 19:29
[Información] Exportar archivos de PowerCOBOL 5 a Web fastpho PowerCOBOL (ActiveX, v4 - v11) 10 21 de noviembre de 2017 19:48
[Sintaxis] Ordenar CmListView Breew PowerCOBOL (ActiveX, v4 - v11) 5 20 de marzo de 2017 13:24
Respuesta
 
Herramientas

  #1
Antiguo 25 de febrero de 2015, 23:31
IDENTIFICATION DIVISION
Rapinto
Gran amigo del Foro y Guru de COBOL
Activista del Foro: Activista del Foro - Razón: ¡Gracias!  Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Razón: Por ayudar mucho a los foreros  Guru de los Gurus: Por solidos y amplios conocimientos - Razón: Por saber demasiado! 
ENVIRONMENT DIVISION
Avatar de Rapinto
DATA DIVISION
Forero desde (Registrado)febrero 2015
Portugal
Ubicación Porto
Última Actividad29.01.2018 20:23
PROCEDURE DIVISION
PostsPosts: 246
Ha dicho GraciasEnviado: 19
Ha recibido agradecimientosRecibido: 218
Mejores respuestasSoluiones: 47
ReputaciónReputación: 15
Rapinto is on a distinguished road Rapinto is on a distinguished road Rapinto is on a distinguished road Rapinto is on a distinguished road Rapinto is on a distinguished road Rapinto is on a distinguished road Rapinto is on a distinguished road
Relación de tablas Exportar CmListview en Excel

Josber,

Podes completar o teu exemplo, com o Envio da cmListview1 para Excel.
Cria um ficheiro de texto com o código a seguir, chamado (por exemplo)
EXPCONSULTAS.COB

Código COBOL:
  1. *
  2.        ENVIRONMENT DIVISION.
  3.        DATA            DIVISION.
  4.        WORKING-STORAGE SECTION.
  5.        01  EXCEL              OBJECT REFERENCE OLE.
  6.        01  WORKBOOK           OBJECT REFERENCE OLE.
  7.        01  SHEETS             OBJECT REFERENCE OLE.
  8.        01  WORKSHEET          OBJECT REFERENCE OLE.
  9.        01  CELL               OBJECT REFERENCE OLE.
  10.        01  COLUMNS            OBJECT REFERENCE OLE.
  11.        01  WCOLUMN            OBJECT REFERENCE OLE.
  12.        01  OBJRANGE           OBJECT REFERENCE OLE.
  13.        01  FITRANGE           OBJECT REFERENCE OLE.
  14. *
  15.        01 ARRAYOBJ OBJECT REFERENCE COM-ARRAY.
  16.        01 LONG-INT-TYPE           PIC S9(9) COMP-5 VALUE 12.
  17.        01 ARRAY-DIMENSION         PIC S9(9) COMP-5 VALUE 2.
  18.        01 AXIS-1                  PIC S9(9) COMP-5 VALUE 22.
  19.        01 AXIS-2                  PIC S9(9) COMP-5 VALUE 22.
  20. *
  21.        01  APPLICATION                    PIC X(20) VALUE "EXCEL.APPLICATION".
  22.        01  OLE-TRUE                       PIC 1(1)  BIT VALUE B"1".
  23.        01  FILLER                         PIC 1(7)  BIT.        
  24.        01  OLE-FALSE                      PIC 1(1)  BIT VALUE B"0".
  25.        01  FILLER                         PIC 1(7)  BIT.        
  26.        01  ARRAY-ROW                      PIC S9(9) COMP-5.
  27.        01  ARRAY-COL                      PIC S9(9) COMP-5.
  28.        01  VAL                            PIC X(256).
  29.        01  S-INDEX                        PIC S9(4) COMP-5 VALUE 1.
  30.        01  LINHA                          PIC X(1024).
  31.        01  OLE-ERR-METHOD                 PIC X(256).
  32.        01  OLE-ERR-INFO.                                                
  33.            03  OLE-ERR-TYPE           PIC X(001).                          
  34.            03  OLE-ERR-WCODE          PIC X(002).                          
  35.            03  ROLE-ERR-WCODE REDEFINES OLE-ERR-WCODE  PIC S9(04) COMP-5.
  36.            03  OLE-ERR-SCODE          PIC X(004).                          
  37.            03  ROLE-ERR-SCODE REDEFINES OLE-ERR-SCODE PIC S9(09) COMP-5.
  38. *
  39.        01  XARRCOL                 PIC X(026)  VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
  40.        01  ARRCOLS  REDEFINES XARRCOL.
  41.            03   ARRCOL    OCCURS 26   PIC X(001).
  42. *
  43.        01  FORMATNUM               PIC X(9)  VALUE "#.##0,00".      
  44.        01  FORMATDATE              PIC X(12) VALUE "aaaa-mm-dd".
  45.        01  NRCOLS                  PIC S9(9) COMP-5   VALUE 1.
  46.        01  INIROW                  PIC S9(9) COMP-5   VALUE 2.
  47.        01  INICOL                  PIC S9(9) COMP-5   VALUE 1.
  48.        01  ENDROW                  PIC S9(9) COMP-5   VALUE 2.
  49.        01  ENDCOL                  PIC S9(9) COMP-5   VALUE 22.
  50.        01  INIRANGE                PIC X(19)          VALUE " A0000002: Z0000002".
  51.        01  ROWVAL                  PIC 9(007).
  52.        01  COLVAL                  PIC 9(007).
  53.        01  PICSTRING               PIC X(020).
  54.        01  PICDATE                 PIC X(10).
  55.        PROCEDURE DIVISION.
  56.        DECLARATIVES.                                              
  57.        OLE-ERRO SECTION.                                          
  58.             USE AFTER EXCEPTION OLE-EX.                          
  59. *
  60.        END DECLARATIVES.                                          
  61. *
  62.        MAIN SECTION.
  63.        MAIN-00.                                          
  64.            IF "COUNT" OF CMLISTVIEW1 = ZERO GO TO MAIN-99.
  65.            MOVE 11                              TO "MousePointer" OF POW-SELF.
  66.            MOVE 1                               TO WSLONG.
  67.            MOVE 1                               TO S-INDEX.
  68.            INVOKE OLE "CREATE-OBJECT" USING APPLICATION RETURNING EXCEL.
  69.            INVOKE EXCEL "GET-WORKBOOKS" RETURNING WORKBOOK.
  70.            INVOKE WORKBOOK "ADD"                 RETURNING WORKBOOK.
  71.            INVOKE WORKBOOK "GET-WORKSHEETS" RETURNING SHEETS.
  72.            INVOKE SHEETS   "GET-ITEM" USING S-INDEX   RETURNING WORKSHEET.
  73. *
  74.            MOVE "ColumnCount" OF CmListView1    TO IDX1.
  75. *
  76.                  MOVE 1                               TO IDX5.
  77.                  PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
  78.                  IF "Width" OF "Columns"(IDX2) OF CMLISTVIEW1 > 5
  79.                        MOVE "HeaderText" OF "Columns"(IDX2) OF CmListView1 TO VAL
  80.                        MOVE  WSLONG TO ARRAY-ROW    MOVE IDX5 TO ARRAY-COL
  81.                        INVOKE WORKSHEET "GET-CELLS" USING ARRAY-ROW ARRAY-COL
  82.                              RETURNING CELL
  83.                        INVOKE CELL "SET-VALUE" USING VAL
  84.                          ADD 1                             TO IDX5
  85.                       END-IF
  86.                  END-PERFORM.
  87. *
  88.                  ADD 1                                TO WSLONG.
  89.                  MOVE "Count" OF CmListView1          TO IDX1.
  90.                  MOVE "ColumnCount" OF CmListView1    TO IDX2.
  91. *
  92.                  MOVE IDX1 TO AXIS-1.
  93.                  MOVE IDX2 TO AXIS-2.
  94.                  INVOKE COM-ARRAY "NEW" USING LONG-INT-TYPE ARRAY-DIMENSION AXIS-1
  95.                                        AXIS-2 RETURNING ARRAYOBJ.
  96.            INVOKE POW-SELF "THRUEVENTS".
  97. *
  98. *  VAI CARREGAR O ARRAY BIDINENSIONAL OLE-ARRAY A PARTIR DA LISTVIEW
  99. *
  100.            PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > IDX1
  101.              MOVE 1 TO IDX5
  102.                   PERFORM VARYING IDX4 FROM 1 BY 1 UNTIL IDX4 > IDX2
  103.                       IF "Width" OF "Columns"(IDX4) OF CMLISTVIEW1 > 5
  104.                             MOVE "Text"(IDX4) OF "ListItems"(IDX3) OF CmListView1   TO LINHA
  105.                             INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
  106.                             ADD 1 TO IDX5
  107.                        END-IF
  108.                   END-PERFORM
  109.               IF IDX3 = 5000 OR = 10000 OR = 15000 OR = 20000 OR = 250000 OR = 30000
  110.                              OR = 35000 OR = 40000
  111.                          INVOKE POW-SELF "THRUEVENTS"
  112.               END-IF
  113.            END-PERFORM.
  114. *
  115. ************  CALCULAR O "RANGE" DA FOLHA TODA PARA ENVIAR O ARRAY DUMA SO VEZ
  116. *  A PRIMEIRA CELULA É SEMPRE "A00002"
  117.            MOVE 1    TO ROWVAL ADD 1 TO ROWVAL  MOVE ROWVAL TO INIRANGE(3:7).
  118.            IF IDX2 < 27
  119.                 MOVE " "          TO INIRANGE(11:1)
  120.                 MOVE ARRCOL(IDX2) TO INIRANGE(12:1)
  121.              ELSE
  122.                 SUBTRACT 26 FROM IDX2 GIVING COLVAL
  123.                 MOVE "A"          TO INIRANGE(11:1)
  124.                 MOVE ARRCOL(COLVAL) TO INIRANGE(12:1)
  125.            END-IF.
  126.            MOVE IDX1 TO ROWVAL ADD 1 TO ROWVAL.
  127.            MOVE ROWVAL TO INIRANGE(13:7).
  128.            INVOKE WORKSHEET "GET-RANGE" USING INIRANGE RETURNING OBJRANGE.
  129.            INVOKE OBJRANGE "SET-VALUE" USING ARRAYOBJ.
  130. *
  131.       MAIN-80.
  132. *
  133. * UTILIZANDO O RANGE QUE FOI DAS COLUNAS/LINHAS UTILIZADAS VAI FAZER O AUTOFIT (ALARGAR AS COLUNAS)
  134. *
  135.              INVOKE WORKSHEET   "GET-USEDRANGE"       RETURNING OBJRANGE.
  136.              INVOKE OBJRANGE "GET-ENTIRECOLUMN" RETURNING FITRANGE.
  137.              INVOKE FITRANGE "AUTOFIT".
  138.              MOVE 0 TO "MousePointer" OF POW-SELF.
  139. *  DESTRUIR OS OBJECTOS UTILIZADOS PARA LIBERTAR MEMORIA
  140.              INVOKE EXCEL "SET-VISIBLE" USING OLE-TRUE.
  141.              INVOKE EXCEL "QUIT".
  142.              SET CELL      TO NULL.
  143.              SET COLUMNS   TO NULL.
  144.              SET FITRANGE  TO NULL.
  145.              SET OBJRANGE  TO NULL.
  146.              SET WORKSHEET TO NULL.
  147.              SET SHEETS    TO NULL.
  148.              SET WORKBOOK  TO NULL.
  149.              SET EXCEL     TO NULL.
  150.        MAIN-99.
  151.                  EXIT PROGRAM.

No PowerCobol na FORM que contem a CMListView1, em REPOSITORY devem entrar as 3 linhas finais do exemplo acima.
Código COBOL:
  1.   CLASS OLE AS "*OLE"
  2.   CLASS OLE-EX AS "*OLE-EXCEPTION"
  3.   CLASS COM-ARRAY AS "*COM-ARRAY".
Num Click do botão de "Exportar para Excel" retira o código que aparece "by default"
e coloca:
#INCLUDE "..\EXPCONSULTAS.COB".
Compila e teras uma exportação para Excel muito rápida, pois envia para o Excel Um array inteiro de uma só vez.

Um saludo,
Rui Pinto

Última edición por Rapinto fecha: 25 de febrero de 2015 a las 23:53.
Rapinto no ha iniciado sesión   Responder Con Cita
Han dicho Gracias: 4
Angel (16 de diciembre de 2017), Josber (27 de febrero de 2015), Kuk (26 de febrero de 2015), Recato53 ( 9 de marzo de 2015)
Respuesta


Usuarios activos actualmente viendo este tema: 1 (0 miembros y 1 visitantes)
 
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



La franja horaria es GMT +1. Ahora son las 03:35.
Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2021, Jelsoft Enterprises Ltd.