Exportar CmListview en Excel

[Rapinto]

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

*
       ENVIRONMENT DIVISION.
       DATA            DIVISION.
       WORKING-STORAGE SECTION.
       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 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.                           
*
       END DECLARATIVES.                                          
*
       MAIN SECTION.
       MAIN-00.                                          
           IF "COUNT" OF CMLISTVIEW1 = ZERO GO TO MAIN-99.
           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 CmListView1    TO IDX1.
*
                 MOVE 1                               TO IDX5.
                 PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > IDX1
                 IF "Width" OF "Columns"(IDX2) OF CMLISTVIEW1 > 5
                       MOVE "HeaderText" OF "Columns"(IDX2) OF CmListView1 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
                         ADD 1                             TO IDX5
                      END-IF
                 END-PERFORM.
*
                 ADD 1                                TO WSLONG.
                 MOVE "Count" OF CmListView1          TO IDX1.
                 MOVE "ColumnCount" OF CmListView1    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".
*
*  VAI 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 "Columns"(IDX4) OF CMLISTVIEW1 > 5
                            MOVE "Text"(IDX4) OF "ListItems"(IDX3) OF CmListView1   TO LINHA
                            INVOKE ARRAYOBJ "SET-DATA" USING LINHA IDX3 IDX5
                            ADD 1 TO IDX5
                       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
*  A 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.
*
* UTILIZANDO 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.
*  DESTRUIR 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.
                 EXIT PROGRAM.

No PowerCobol na FORM que contem a CMListView1, em REPOSITORY devem entrar as 3 linhas finais do exemplo acima.

  CLASS OLE AS "*OLE"
  CLASS OLE-EX  AS "*OLE-EXCEPTION"
  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