Quantcast
Channel: Net Express / Server Express - Forum - Recent Threads
Viewing all articles
Browse latest Browse all 375

RE: Integração NetExpress 3.1 com MS Word

$
0
0

Eu estou construindo uma classe para facilitar o uso da WORD API

Ainda está precária, mas já tem as funções mais comuns.

Copy and enjoy.

=============================================================

     $set ooctrl(+P)

     *-----------------------------------------------------------------*

     * Modulo : cblWrdAPI                                              *

     * Função :                                                        *

     *                                                                 *

     * Se este código não funcionar, nem imagino que o escreveu, porem,*

     * se funcionar, ele foi escrito por:                              *

     *-----------------------------------------------------------------*

     *                                     .-----,                     *

     *                          __    o   /        __         _  __    *

     *                          __)   |   `-----,  __) |  | |/  |  |   *

     *                         |  |   |        /  |  | |  | |   |  |   *

     *                         `--'`--' `-----'   `--' `--' '   `--'   *

     * Sertanejo, tô fora!                         ajsauro@gmail.com   *

     *-----------------------------------------------------------------*

     * Pede-se a gentileza de, caso alguém venha a alterar ou incluir  *

     * função, enviar a mesma para o e-mail acima.                     *

     *-----------------------------------------------------------------*

     *******************************************************************

      class-id.    cblWrdAPI data is protected

                             inherits from Base

                             .

     *------------------------------

      object                 section.

     *------------------------------

      Class-Control.

     *-------------

      *> Native Object COBOL classes

          olesup is class "olesup"           *> OLE support class

     *

          cblWrdAPI is class "cblWrdAPI"

          WordApp is class "$OLE$word.application"

          cStrUtil is class 'cblStrUtil'

          .

     *------------------------------

      Working-Storage        Section.

     *------------------------------

     /    COPY     'msword.CPY'.

      01 WdOrientation    pic s9(9) comp-5 typedef.

         88 wdOrientPortrait           VALUE 0.

         88 wdOrientLandscape          VALUE 1.

     *

      01 WdSeekView    pic s9(9) comp-5. *> typedef.

         88 wdSeekMainDocument         VALUE 0.

         88 wdSeekPrimaryHeader        VALUE 1.

         88 wdSeekFirstPageHeader      VALUE 2.

         88 wdSeekEvenPagesHeader      VALUE 3.

         88 wdSeekPrimaryFooter        VALUE 4.

         88 wdSeekFirstPageFooter      VALUE 5.

         88 wdSeekEvenPagesFooter      VALUE 6.

         88 wdSeekFootnotes            VALUE 7.

         88 wdSeekEndnotes             VALUE 8.

         88 wdSeekCurrentPageHeader    VALUE 9.

         88 wdSeekCurrentPageFooter    VALUE 10.

     *

      01 WdPaperSize    pic s9(9) comp-5. *> typedef.

         88 wdPaper10x14               VALUE 0.

         88 wdPaper11x17               VALUE 1.

         88 wdPaperLetter              VALUE 2.

         88 wdPaperLetterSmall         VALUE 3.

         88 wdPaperLegal               VALUE 4.

         88 wdPaperExecutive           VALUE 5.

         88 wdPaperA3                  VALUE 6.

         88 wdPaperA4                  VALUE 7.

         88 wdPaperA4Small             VALUE 8.

         88 wdPaperA5                  VALUE 9.

         88 wdPaperB4                  VALUE 10.

         88 wdPaperB5                  VALUE 11.

         88 wdPaperCSheet              VALUE 12.

         88 wdPaperDSheet              VALUE 13.

         88 wdPaperESheet              VALUE 14.

         88 wdPaperFanfoldLegalGerman  VALUE 15.

         88 wdPaperFanfoldStdGerman    VALUE 16.

         88 wdPaperFanfoldUS           VALUE 17.

         88 wdPaperFolio               VALUE 18.

         88 wdPaperLedger              VALUE 19.

         88 wdPaperNote                VALUE 20.

         88 wdPaperQuarto              VALUE 21.

         88 wdPaperStatement           VALUE 22.

         88 wdPaperTabloid             VALUE 23.

         88 wdPaperEnvelope9           VALUE 24.

         88 wdPaperEnvelope10          VALUE 25.

         88 wdPaperEnvelope11          VALUE 26.

         88 wdPaperEnvelope12          VALUE 27.

         88 wdPaperEnvelope14          VALUE 28.

         88 wdPaperEnvelopeB4          VALUE 29.

         88 wdPaperEnvelopeB5          VALUE 30.

         88 wdPaperEnvelopeB6          VALUE 31.

         88 wdPaperEnvelopeC3          VALUE 32.

         88 wdPaperEnvelopeC4          VALUE 33.

         88 wdPaperEnvelopeC5          VALUE 34.

         88 wdPaperEnvelopeC6          VALUE 35.

         88 wdPaperEnvelopeC65         VALUE 36.

         88 wdPaperEnvelopeDL          VALUE 37.

         88 wdPaperEnvelopeItaly       VALUE 38.

         88 wdPaperEnvelopeMonarch     VALUE 39.

         88 wdPaperEnvelopePersonal    VALUE 40.

         88 wdPaperCustom              VALUE 41.

     *

      77           j                   pic 9(003).

      77           k                   pic 9(003).

      77           wChar               Pic X(001).

      78           mfUtil              value 'mfUtil'.

     *

      01           lsParametro.

        05         lsFuncao            PIC X(030).

        05         lsSubFuncao         PIC X(030).

        05         lsStatus            PIC X(002).

        05         lsSizeOfString      PIC 9(003).

        05         lsPalavras          PIC 9(003).

        05         lsChar1             PIC X(001).

        05         lsChar2             PIC X(001).

        05         lsString.

          10       lsSChar             PIC X(001) Occurs 256.

        05         lsString2.

          10       lsSChar2            PIC X(001) Occurs 256.

      01           found               pic x comp-5.

        88         found-True          value 45.

        88         found-False         value 48.

      01           Program-Flags       PIC 9(2) COMP-5 VALUE 1.

        88         New-Instance        VALUE 1 FALSE 0.

     */////////////////////////////////////////////////////////////////

      Class-Object.

      Object-Storage         Section.

      method-id. "CriarObjeto".

      linkage section.

      77           lnkWrdAPP           object reference.

     ******************************************************************

      Procedure              Division  Returning lnkWrdAPP.

     ******************************************************************

          invoke   super "new" returning lnkWrdAPP

          exit method

          .

      end method "CriarObjeto".

      End Class-Object.

     */////////////////////////////////////////////////////////////////

     *

      Object.

     *------------------------------

      Object-Storage         Section.

     *------------------------------

      77           cblStrUtil          Object Reference Value Null.

     *

      01           wText               Pic X(255).

      01           WordServer          object reference value null.

      01           theActiveWindow     Object Reference value NULL.

      01           theActivePane       Object Reference value NULL.

      01           theView             Object Reference value NULL.

      01           theTypeText         Object Reference value NULL.

      01           theDocuments        object reference value null.

      01           theDocument         object reference value null.

      01           theSelection        object reference value null.

      01           PageSetup           Object Reference value NULL.

      01           theReplacement      object reference value null.

      01           theParagraphs       object reference value null.

      01           theParagraph        object reference value null.

      01           theRange            object reference value null.

      01           theFind             object reference value null.

      01           theFont             object reference value null.

     *------------------------------

      Method-Id. "CreateAplication".

     *------------------------------

      Local-Storage          Section.

     *------------------------------

      Linkage                Section.

     *------------------------------

      01           wordVisible         pic s9(001).

     ******************************************************************

      Procedure              Division Using wordVisible.

     ******************************************************************

          *> Set the timeout for the OLE "busy" error to 100ms

          *> Using this method is recommended for Word applications

          Invoke olesup "setOLEBusyTimeout" using by value 100

          *> Criar uma instancia do Word

          Invoke   wordapp "new"       Returning wordServer

          *> Seta se o Word será visualizado

          invoke   wordServer "SetVisible" using by value wordVisible

          If       cblStrUtil          Is Equal Null

                   Invoke cStrUtil "CriarObjeto" Returning cblStrUtil

          End-If

          Exit     Method

          .

      End Method "CreateAplication".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-id. "A4".

     *******************************************************************

      Procedure              division.

     *******************************************************************

          Set      wdPaperA4           to TRUE

          Invoke   PageSetup "setPaperSize" Using WdPaperSize

          Exit     Method

          .

      End method "A4".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Pegar a orientação da pagina                                    *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "getPageOrientation".

      linkage section.

      01           Orientation         WdOrientation.

      procedure division returning Orientation.

          Invoke   PageSetup "getOrientation" returning Orientation

          Exit     Method

          .

      end method "getPageOrientation".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Setar a orientação da página para o modo "Retrato"              *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-id. "Retrato".

     *******************************************************************

      Procedure              division.

     *******************************************************************

          Invoke   SELF "Portrait"

          Exit     Method

          .

      End method "Retrato".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Setar a orientação da página para o modo "Retrato"              *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-id. "Portrait".

     *------------------------------

      Local-Storage          section.

     *------------------------------

      01           Orientation         WdOrientation.

     *******************************************************************

      Procedure              division.

     *******************************************************************

          Set      wdOrientPortrait of Orientation to TRUE

          Invoke   PageSetup "setOrientation" Using Orientation

          Exit     Method

          .

      End method "Portrait".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Setar a orientação da página para o modo "Paisagem"             *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-id. "Paisagem".

     *******************************************************************

      Procedure              division.

     *******************************************************************

          Invoke   SELF "Landscape"

          Exit     Method

          .

      End method "Paisagem".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Setar a orientação da página para o modo "Paisagem"             *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-id. "Landscape".

     *------------------------------

      Local-Storage          section.

     *------------------------------

      01           Orientation         WdOrientation.

     *******************************************************************

      Procedure              division.

     *******************************************************************

          Set      wdOrientLandscape of Orientation to TRUE

          Invoke   PageSetup "setOrientation" Using Orientation

          Exit     Method

          .

      End method "Landscape".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "SetVisible".

     *------------------------------

      Linkage                Section.

     *------------------------------

      01           wordVisible         pic s9(001).

     ******************************************************************

      Procedure              Division  Using wordVisible.

     ******************************************************************

          *> Seta se o Word será visualizado

          Invoke   wordServer "SetVisible" using by value wordVisible

          Exit     Method

          .

      End Method "SetVisible".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "Add".

     ******************************************************************

      Procedure              Division.

     ******************************************************************

          *> Pega o objeto de coleção Word documents

          Invoke   wordServer "getDocuments" Returning theDocuments

          Invoke   theDocuments "Add"

          Invoke   theDocuments "finalize" returning theDocuments

          Invoke   wordServer "getSelection" returning theSelection

          *> Pega o objeto PageSetup

          Invoke   theSelection "getPageSetup" returning PageSetup

          Invoke   theSelection "getParagraphFormat"

                                       returning theParagraph

          Invoke   theParagraph "setSpaceAfter" Using by value 0

          Invoke   theSelection "getFont" returning theFont

          Invoke   theFont "setName" Using z"Courier New"

          Invoke   theFont "setSize" Using by value 8

          Invoke   theFont "Finalize" returning theFont

          Exit     Method

          .

      End Method "Add".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "WholeStory".

     ******************************************************************

      procedure              division.

     ******************************************************************

          Invoke   wordServer "getSelection" returning theSelection

          invoke   theSelection "WholeStory"

          Invoke   theSelection "Finalize" returning theSelection

          Exit     Method

          .

      end method "WholeStory".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "SeekCurrentPageHeader".

     ******************************************************************

      Procedure              Division.

     ******************************************************************

          *> Pega o objeto de coleção Word documents

          Invoke   wordServer "getActiveWindow"

                                       Returning theActiveWindow

          Invoke   theActiveWindow "getActivePane"

                                             Returning theActivePane

          Invoke   theActivePane "getView" returning theView

          Set      wdSeekCurrentPageHeader to true

          Invoke   theView "setSeekView" Using WdSeekView

          Invoke   theActivePane "getSelection" Returning theSelection

          Invoke   theSelection "getFont" returning theFont

          Invoke   theFont "setName" Using z"Courier New"

          Invoke   theFont "setSize" Using by value 8

          Invoke   theFont "Finalize" returning theFont

          Invoke   theActiveWindow "Finalize" returning theActiveWindow

          Invoke   theActivePane   "Finalize" returning theActivePane

          Exit     Method

          .

      End Method "SeekCurrentPageHeader".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "FileOpen".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdFileName         Pic X(255).

     ******************************************************************

      procedure              division using wrdFileName.

     ******************************************************************

          *> Abre o arquivo em wrdFileName

          Invoke   theDocuments "Open" Using wrdFileName

          *> Pega o documento ativo

          Invoke   wordServer "getActiveDocument" Returning theDocument

          exit     method

          .

      End method "FileOpen".

     */////////////////////////////////////////////////////////////////

      Method-id. "SaveAs".

     *------------------------------

      Local-storage          Section.

     *------------------------------

      Linkage                Section.

     *------------------------------

      01           wrdFileName         Pic X(255).

     ******************************************************************

      Procedure              Division  Using wrdFileName.

     ******************************************************************

          Move     'NullTerminate'     to lsFuncao

          Move     wrdFileName         to lsString

          MOVE     LENGTH OF lsString  to lsSizeOfString

          move     ' '                 to lsChar1 lsChar2

          CALL     mfUtil              Using lsParametro

          Move     lsString            to wrdFileName

          Invoke   theDocuments "FileSaveAs" Using wrdFileName

          Exit     Method

          .

      End Method "SaveAs".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Exportar para PDF                                               *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "ExportarParaPDF".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           pdfFileName         Pic X(255).

     ******************************************************************

      Procedure              Division  Using pdfFileName.

     ******************************************************************

          Invoke   SELF "ExportToPDF"  Using pdfFileName

          Exit     Method

          .

      End Method "ExportarParaPDF".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     * Exportar para PDF                                               *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *method-id. "ExportToPDF".

     *------------------------------

     *local-storage          Section.

     *------------------------------

     *linkage                Section.

     *------------------------------

     *01           pdfFileName         Pic X(255).

     ******************************************************************

     *Procedure              Division  Using pdfFileName.

     ******************************************************************

     *      ChangeFileOpenDirectory "C:\Users\Usuário\Desktop\"

     *      ActiveDocument.ExportAsFixedFormat OutputFileName:= _

     *          "C:\Users\Usuário\Desktop\sgfdsfg.pdf", ExportFormat:=wdExportFormatPDF, _

     *          OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, Range:= _

     *          wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _

     *          IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _

     *          wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _

     *          True, UseISO19005_1:=False

     *

     *    Exit     Method

     *    .

     *End Method "ExportToPDF".

     */////////////////////////////////////////////////////////////////

      method-id. "DeleteSelection".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

     ******************************************************************

      procedure              division.

     ******************************************************************

     *    invoke wordServer "getSelection" returning theSelection

     *    invoke theSelection "Delete"

          *> Seleciona o texto encontrado

          invoke   theRange "select"

          *> 'CUTila' o texto encontrado

          invoke   theRange "Cut"

          exit     method

          .

      end method "DeleteSelection".

     */////////////////////////////////////////////////////////////////

      method-id. "NewLine".

     ******************************************************************

      procedure              division.

     ******************************************************************

          *> Insere o texto

          invoke   theSelection "InsertAfter" using z" "

          exit     method

          .

      end method "NewLine".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "setPageHeader".

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdText             Pic X(256).

     ******************************************************************

      procedure              division using wrdText.

     ******************************************************************

          Invoke   SELF "SeekCurrentPageHeader"

     *    Invoke   cblStrUtil "NullTerminate" Using wrdText

          *>Invoke   theSelection "setText" Using wrdText

     *    Invoke   SELF "InsertText" Using wrdText

     *    Set      wdSeekMainDocument    to true

     *    Invoke   theView "setSeekView" Using WdSeekView

     *

     *    Invoke   theView         "Finalize" returning theView

     *

          Exit     Method

          .

      End Method "setPageHeader".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "EndPageHeader".

     ******************************************************************

      Procedure              Division.

     ******************************************************************

          Set      wdSeekMainDocument    to true

          Invoke   theView "setSeekView" Using WdSeekView

          Invoke   theView         "Finalize" returning theView

          Exit     Method

          .

      End Method "EndPageHeader".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "InsertText".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdText             Pic X(256).

     ******************************************************************

      procedure              division using wrdText.

     ******************************************************************

          Invoke   cblStrUtil "NullTerminate" Using wrdText

          *> Insere o texto

          Invoke   theSelection "TypeText" using by content wrdText

          Exit     Method

          .

      end method "InsertText".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *                                                                 *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      method-id. "TypeParagraph".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdText             Pic X(256).

     ******************************************************************

      procedure              division using wrdText.

     ******************************************************************

          Invoke   theSelection "TypeParagraph"

          Exit     Method

          .

      end method "TypeParagraph".

     */////////////////////////////////////////////////////////////////

      method-id. "FindText".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdText             Pic X(255).

      01           wrdSearchStatus     Pic X(002).

     ******************************************************************

      procedure              division using wrdText,

                                  returning wrdSearchStatus.

     ******************************************************************

          Move     "23"                To wrdSearchStatus

          Move     'NullTerminate'     to lsFuncao

          Move     wrdText             to lsString

          MOVE     LENGTH OF lsString  TO lsSizeOfString

          move     ' '                 to lsChar1 lsChar2

          CALL     mfUtil              USING lsParametro

          Move     lsString            to wrdText

          Invoke   Self 'GetTheRange'

          *> Pega o objecto Find

          Invoke   theRange "getFind"   Returning theFind

          *> A procura será para frente

          Invoke   theFind "setForward" Using by value 1

          *> A busca sera pelo conteudo de wrdText

          Invoke   theFind "setText"    Using by content wrdText

          *> Para que a operação de localização localize somente

          *> palavras inteiras, e não texto que seja parte de uma

          *> palavra maior.

     *    Invoke   theFind 'setMatchWholeWord' using by value 1

          *> Procurar

          Invoke   theFind "execute"

          *> Encontrou ?

          Invoke   theFind "getFound"  Returning found

          *> Se encontrou...

          If       found-True

                   Move "00"           To wrdSearchStatus

          End-if

          exit     method

          .

      end method "FindText".

     */////////////////////////////////////////////////////////////////

      method-id. "ReplaceText".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdChange2          Pic X(255).

     *******************************************************************

      procedure              division using wrdChange2.

     *******************************************************************

          Move     'TamanhoSTR'        to lsFuncao

          MOVE     LENGTH OF wrdChange2 TO lsSizeOfString

          MOVE     wrdChange2          TO lsString

          CALL     mfUtil              USING lsParametro

          *> Seleciona o texto encontrado

          invoke   theRange "select"

          *> Finalmente, muda o texto encontrado (wrdText)

          *> para o desejado

          invoke   theRange "Cut"

          MOVE     ZEROS               TO j

          Move     lsSizeOfString      to k

          perform  until j             = k

                   add 01              to j

                   move wrdChange2(j:1) to wChar

                   invoke theRange "InsertAfter" using by content wChar

          end-perform

          *> Não preciso mais dos objetos Find e Range

          Invoke   theFind "finalize"  Returning theFind

          Invoke   theRange "finalize" Returning theRange

          exit     method

          .

      end method "ReplaceText".

     */////////////////////////////////////////////////////////////////

      method-id. "FindAndReplaceText".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wrdText             Pic X(255).

      01           wrdChange2          Pic X(255).

      01           wrdSearchStatus     Pic X(002).

     *******************************************************************

      procedure              division using wrdText,

                                            wrdChange2,

                                  returning wrdSearchStatus.

     *******************************************************************

          Move     "23"                To wrdSearchStatus

          Move     'TamanhoSTR'        to lsFuncao

          Move     wrdChange2          to lsString

          CALL     mfUtil              USING lsParametro

          Move     lsSizeOfString      to k

          Move     'NullTerminate'     to lsFuncao

          CALL     mfUtil              USING lsParametro

          Move     lsString            to wrdChange2

          Move     wrdText             to lsString

          MOVE     LENGTH OF lsString  TO lsSizeOfString

          CALL     mfUtil              USING lsParametro

          Move     lsString            to wrdText

          Invoke   Self 'GetTheRange'

          *> Pega o objecto Find

          Invoke   theRange "getFind"   Returning theFind

     /    Invoke   theFind "getReplacement"   Returning theReplacement

          *> A procura será para frente

          Invoke   theFind "setForward" Using by value 1

          *> A busca sera pelo conteudo de wrdText

          Invoke   theFind "setText"    Using by content wrdText

     /    Invoke   theReplacement "setText" Using by content wrdChange2

          *> Procurar

          Invoke   theFind "execute"

          *> Encontrou ?

          Invoke   theFind "getFound"  Returning found

          invoke   theFind "finalize"  Returning theFind

          *> Se encontrou...

          If       found-True

                   Move "00"           To wrdSearchStatus

                   invoke theRange "select"

                   invoke theRange "setText" using

                                       by content wrdChange2(1:k)

          End-if

          exit     method

          .

      end method "FindAndReplaceText".

     */////////////////////////////////////////////////////////////////

      method-id. "GetTheRange".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

     *******************************************************************

      procedure              division.

     *******************************************************************

          *> Pega o objeto Range

          Invoke   theDocuments "getContent" returning theRange

          exit     method

          .

      end method "GetTheRange".

     */////////////////////////////////////////////////////////////////

      method-id. "PrintPreview".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

     *******************************************************************

      procedure              division.

     *******************************************************************

          invoke   theDocument "PrintPreview"

          exit     method

          .

      end method "PrintPreview".

     */////////////////////////////////////////////////////////////////

      method-id. "PrintDocument".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

     *******************************************************************

      procedure              division.

     *******************************************************************

          invoke   theDocument "PrintOut" using by value 0

          exit     method

          .

      end method "PrintDocument".

     */////////////////////////////////////////////////////////////////

      method-id. "QuitCloseFile".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

      01           wordSaveMode        pic s9(001).

     *******************************************************************

      procedure              division using wordSaveMode.

     *******************************************************************

          *> Fechar o arquivo...

          If       wordSaveMode        = 0

             *>...sem salva-lo

                   Invoke theDocument "Close" Using by value 0

          Else

           If      wordSaveMode        = -1

             *>...salvando-o

                   Invoke theDocument "Close" Using by value -1

           End-if

          End-if

          Invoke   theDocument "finalize" Returning theDocument

          exit     method

          .

      end method "QuitCloseFile".

     */////////////////////////////////////////////////////////////////

      method-id. "Quit".

     *------------------------------

      local-storage          Section.

     *------------------------------

      linkage                Section.

     *------------------------------

     *******************************************************************

      procedure              division.

     *******************************************************************

          *> Finalizar o objecto de coleção Documents

          Invoke   theDocuments "finalize" Returning theDocuments

          *> Tell Word to quit (it won't shut down otherwise)

          Invoke   wordServer "quit"

          *> Finalizar o Word

          Invoke   wordServer "finalize" Returning wordServer

          .

      end method "Quit".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

     *               Finalizar as classes usadas                       *

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*

      Method-Id. "Finalize".

     *------------------------------

      Linkage                Section.

     *------------------------------

      77           lnkObjeto           object reference.

     *******************************************************************

      Procedure              Division  Returning lnkObjeto.

     *******************************************************************

          Invoke   cblStrUtil "Finalize" returning cblStrUtil

          If       WordServer          not equal null

                   Invoke WordServer "Finalize" returning WordServer

          End-If

          Invoke   SUPER "Finalize" Returning lnkObjeto

          Exit     Method

          .

      End Method "Finalize".

     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

      End Object.

     *//////////////////////////////////////////////////////////////////

      End Class    cblWrdAPI.

     ******************************************************************

How ca*n I reset the currect Selection in Microsoft Word from COBOL

Proble*m:

     *

If you*are using the "InsertAfter" method of the selection object to enter text into a Word document then the selection is expanded with the new text.

     *

This c*n cause problems when you jsut want to apply formatting (Bold etc) to some of the text. If you apply Bold then it applies to all the selection.

     *

Resolu*ion:

     *

You ca* use the "Collapse" method of the selection object reset the selection down to just the current text entry position. Some example code to perform this is:-

     *

     *   *> Here we want to do collapse and bold the next text

     *

     *    set wdCollapseEnd of ws-direction to true

     *

     *    invoke theSelection "Collapse" using ws-direction

     *

     *    invoke theSelection "InsertAfter" using

     *

     *   "This is some text that need to be bold" & x"0d"

     *

     *    invoke theSelection "getFont" returning theFont

     *

     *    set Size-CBL  to 12

     *

     *    invoke theFont "setSize" using by value Size-CBL

     *

     *    set Size-CBL  to 1

     *

     *    invoke theFont "setBold" using by value Size-CBL

     *

     *    invoke theFont "setUnderline" using by value Size-CBL

     *

     *    invoke theFont "finalize"  returning theFont

     *

     *    invoke theSelection "finalize" returning theSelection

     *

For fu*l details on the "Collapse" method please see the help provided with Microsoft Word.


Viewing all articles
Browse latest Browse all 375

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>