PC Toledo

Código: Selecionar todos

#include "FiveWin.ch"

#define CR             Chr(13)
#define LF             Chr(10)  

#define BS             "\"

Function OLEMerge( cDOCFile, cDBFile, cVFields, cQtCol, cQtLin, lDOCPreview )
/* O parametro lDOCPreview nao consegui utilizar no seu código anterior. 
Este serviria para visualizar o arquivo ou até imprimi-lo, não é ?*/

LOCAL cHomeDir := CurDrive() + ":" + BS + CurDir() + BS
LOCAL oDoc,oWord,oText,oFind,cFound,bError,cFile,cText

IF cDOCFile=NIL
   MsgInfo( "Falta parametro sobre o arquivo do Word." )
ELSE
   cFile := cHomeDir + cDOCFile
   if !File(cFile)
      MsgInfo( "Arquivo "+cFile+" nao encontrado." )
      QUIT
   endif
ENDIF
IF cDBFile=NIL
   MsgInfo( "Falta parametro sobre o arquivo DBF." )
ELSE
   if !File(cHomeDir + cDBFile + (IF(".DBF" $ cDBFile,"",".DBF")) )
      MsgInfo( "Arquivo "+cDBFile+" n„o encontrado." )
      QUIT
   endif
   USE (cHomeDir + cDBFile) READONLY
ENDIF
aVFields := StringToArray( cVFields, ";" )
vt := len( aVFields )
IF vt = 0
   MsgInfo( "Precisa informar os nomes dos campos do DBF." )
   QUIT
ENDIF
IF VAL(cQtCol)=0
   MsgInfo( "A quantidade de colunas para etiquetas nao esta correta." )
   QUIT
ELSE
   cQtCol := VAL(cQtCol)
ENDIF
IF VAL(cQtLin)=0
   MsgInfo( "A quantidade de linhas para etiquetas nao esta correta." )
   QUIT
ELSE
   cQtLin := VAL(cQtLin)
ENDIF
IF lDOCPreview=NIL
   lDOCPreview := .t.
ELSE
   lDOCPreview := .f.
ENDIF

cTLins:=cQtLin*VT // Obtem quatidade de etiquetas por pagina

aVWords  := {}
FOR I=1 TO cQtCol
    AADD(aVWords,{})
NEXT
vc := 1
i := 1
Do While !EoF()  // Transcrevendo o conteúdo dos campos do DBF para MATRIZ 
   AADD(aVWords[vc],(&(aVFields[i])))
   vc ++
   If vc > cQtCol
      vc := 1
      i ++
      If i > vt
         i := 1
      Endif
   Endif
   SKIP
ENDDO

CursorWait()
oWord :=TOleAuto():New( "Word.Application" )
oDoc  :=oWord:Get( "Documents" )
oWord:Set("Visible",.f.)
oDoc:Open( cFile )
oText:=oWord:Selection()
oFind:=oText:Find()

for vl = 1 to cTLins // Vai processar incialmente apenas a primeira p gina
    for vc = 1 to cQtCol
        oFind:Set("ClearFormatting")
        oFind:Text:="&#*#&"
        oFind:Wrap:=1
        oFind:Set("MatchWildcards",.t.)
        oFind:Execute()
        cFound:=Alltrim(SubStr(aVFields[i],3,Len(Alltrim(aVFields[i]))-4))
        cFound:=sSwap(cFound,{Chr(145),Chr(146)},"'")
        cFound:=sSwap(cFound,{Chr(147),Chr(148)},'"')
        if Empty(cFound)
           exit
        endif
        oText:TypeText( aVWords[vc,vl] )
    next
next

if lDOCPreview
   oWord:Set("Visible",.t.)
else
   oWord:PrintOut()
   oWord:Quit()
endif
CursorArrow()
return nil

function StringToArray( cString, cSeparator )
LOCAL nPos
LOCAL aString := {}
DEFAULT cSeparator := ";"
cString := ALLTRIM( cString ) + cSeparator
DO WHILE .T.
   nPos := AT( cSeparator, cString )
   IF nPos = 0
      EXIT
   ENDIF
   AADD( aString, SUBSTR( cString, 1, nPos-1 ) )
   cString := SUBSTR( cString, nPos+1 )
ENDDO
RETURN ( aString )

Function sSwap( cChar, c1, c2 )
LOCAL n1,n2:=-1,ac1,f
IF ValType(c1)="A"
   ac1:=c1
   FOR f=1 TO Len(ac1)
      c1:=ac1[f]
      WHILE .T.
         n1:=At(Upper( c1 ),Upper( cChar ))
         IF n1=0 .OR. n1=n2
            EXIT
         ENDIF
         cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) )
         n2:=n1
      ENDDO
   NEXT
ELSE
   WHILE .T.
      n1:=At(Upper( c1 ),Upper( cChar ))
      IF n1=0 .OR. n1=n2
         EXIT
      ENDIF
      cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) )
      n2:=n1
   ENDDO
ENDIF
return cChar