Hola Foreros:
Necesito combinar información tomada de una tabla MySQL con una plantilla en Word,
he buscado información en el foro pero los ejemplos que hay no me funcionan, tal vez
no tengo la última clase TWORD, alguien que quiera compartir la LIB y un pequeño
ejemplo a prueba de ñoño?
Saludos
Combinar correspondencia en WORD
Combinar correspondencia en WORD
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
Re: Combinar correspondencia en WORD
Hola Armando,
Espero te ayude con esto.
Yo lo hago de la siguiente forma (colocando marcas encerradas entre corchetes en la plantilla de word)
Y esta es la clase que utilizo:
Saludos.
Carlos
Espero te ayude con esto.
Yo lo hago de la siguiente forma (colocando marcas encerradas entre corchetes en la plantilla de word)
Code: Select all
Function CombinarWord( cFile, aDatos, lVisualizar )
Local oWord, cFile
oWord := TWord():New()
cFile := cFilePath( HB_ARGV( 0 ) )+cFile
oWord:OpenDoc( cFile )
oWord:Replace("[nombredecliente]",aDatos[1])
oWord:Replace("[direccioncliente]",aDatos[2])
oWord:Replace("[edad]",aDatos[3])
If lVisualizar
//Si se desea se puede guardar la plantilla con otro nombre para dejar la original sin cambios
//oWord:Save( cFilePath( GetModuleFileName( GetInstance() )) + "Tmp\tempcontratotrab.doc" )
oWord:Visualizar()
Else //Imprimir
oWord:PrintDoc()
oWord:End( .f. )
End
Return .t.
Code: Select all
// Clase TWord
// Mira el documento TWord.doc para información
// 2003 Sebastián Almirón
/*
5-Diciembre-2003
Clase TWord
Modificada por : Víctor Manuel Tomás Díaz [ Vikthor ] vikthor@creswin.com
He quitado todas las llamadas a las funciones OleGetProperty() , OleSetProperty() , OleInvoke().
Ahora es usada la clase TOleAuto() y sus Metodos :Get , :Set , :Invoke
++ METHOD Sendmail( lAttach )
++ METHOD HeaderFooter( nOption )
++ METHOD OpenDataSource( cFile )
++ METHOD AddField( cField )
++ METHOD WebPagePreview()
09-Mar-2004
++ Data oTables
++ METHOD AddTables()
08-Jun-2004
++ METHOD View( nView )
oWord:View( 1 ) Vista Normal
oWord:View( 3 ) Vista Diseño
oWord:View( 6 ) Vista Web
++ METHOD Zoom( nPercent )
03-Dic-2004
** Modificación al Metodo New usando TRY y CATCH para recuperar una instacia abierta
crearla o enviar un mensaje de error.
05-Mayo-2005
++ METHOD ChangeField( cText , cNameField )
*/
#include "FiveWin.Ch"
#define TAB chr(9)
#define ENTER chr(13)
#define ALI_LEFT 0
#define ALI_CENTER 1
#define ALI_RIGHT 2
#define ALI_JUSTIFY 3
#define LOGPIXELSX 88
#define LOGPIXELSY 90
// Registros y delimitadores de campos de la estructura GTF
#define SP_REG Chr( 5 )
#define SP_FIELD Chr( 7 )
#define TP_FONT Chr( 15 )
#define TP_COLOR Chr( 16 )
#define TP_ALIGN Chr( 17 )
// Identificador y versión de las ficheros GTF
#define FORMAT_TEXT_TYPE "GTF"
#define FORMAT_TEXT_VERSION "1"
// LA CLASE TWORD
CLASS TWord
DATA oWord
DATA oDocs
DATA oActiveDoc
DATA oTexto
DATA oSelection
DATA cNombreDoc
DATA nLinea,nCol, nPage
DATA nYoffset, nXoffset
DATA lstartpag
DATA oLastSay
DATA lOverflowing
DATA nlastrow
DATA cTextOverflow
DATA lSetCm
DATA oOptions // Objeto Options
DATA oMailMerge // Combinar correspondencia
DATA oDataSource // Objeto MailMergeDataSource
DATA oDataFields // Objeto MailMergeDataFields
DATA oFields // Objeto MailMergeFields
DATA oTables // Objeto Tables
DATA lWord
METHOD AddImagen( nTop, nLeft, nBottom, nRight, cImagen, alinea, ntipo, nrotacion )
METHOD addtabulador(npos, ocuadrotext)
METHOD Box( nTop, nLeft, nBottom, nRight, afondo, alinea, ntipo, nrotation, lsimple )
METHOD close()
METHOD CmSay( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust )
METHOD CheckSpelling()
METHOD End()
METHOD EndPage()
METHOD FillRect( aRect, oBrush )
METHOD GetTextHeight( oFont )
METHOD GetTextWidth(cText, oFont)
METHOD GoBottom() INLINE ::oTexto:Invoke( 'EndKey', 6)
METHOD GoTop() INLINE ::oTexto:Invoke( 'HomeKey', 6)
METHOD JustificaDoc( nJustify, otext )
METHOD Line( nTop, nLeft, nBottom, nRight, oPen, nColor, nStyle )
METHOD New()
METHOD NewDoc( cNombreDoc )
METHOD nLogPixelX() INLINE 55.38
METHOD nLogPixelY() INLINE 55.38
METHOD OpenDoc( cNombreDoc )
METHOD Preview()
METHOD PrintDoc(lbackground, lappend, nRange, cOutputFile, nfrom, nto, nitem, ncopias, cpages)
METHOD Protect(cpassword,nmodo)
METHOD Replace( cOld, cNew )
METHOD Save(cnombredoc)
METHOD Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lvertadjust )
METHOD Say2( nLin,nCol,cTexto,oFuente, nSize, lBold, lShadow, nColor )
METHOD SayGTF( nTop,nLeft, cTextFormat, nBottom,nRight )
METHOD SetCm()
METHOD SetHeader()
METHOD SetLandScape()
METHOD SetMainDoc()
METHOD SetPortrait()
METHOD SetUl()
METHOD StartPage()
METHOD TabClearAll(ocuadrotext)
METHOD TabPredeterminado(ncada)
METHOD TextBox( nTop, nLeft, nBottom, nRight, cTexto, oFuente, nclrtext, nClrBack, nJustify, afondo, alinea, lvertadjust, norientacion)
METHOD UnProtect(cpassword)
METHOD VistaCompleta()
METHOD Visualizar INLINE ::oWord:Visible := .T.
METHOD Write( cTexto, cFuente, cSize, lBold, lShadow, nColor )
METHOD Sendmail( lAttach ) // Vikthor
METHOD HeaderFooter( nOption ) // Vikthor
METHOD OpenDataSource( cFile ) // Vikthor
METHOD AddField( cField ) // Vikthor
METHOD WebPagePreview() INLINE ::oActiveDoc:Invoke("WebPagePreview") // [ Vikthor ] Genera una vista en HTML del libro.
METHOD AddTables( aDatos , nPos ) // [ Vikthor ]
METHOD Find( cText ) // [ Vikthor ]
METHOD Hide() INLINE ::oWord:Visible := .F. // [ Vikthor ]
METHOD IsVisible() INLINE ::oWord:Visible // [ Vikthor ]
METHOD View( nView ) // [ Vikthor ]
METHOD Zoom( nPercent ) // [ Vikthor ]
METHOD ChangeField( cText , cNameField ) // [ Vikthor ]
ENDCLASS
METHOD NEW() CLASS TWord
::lWord := .T.
TRY
::oWord := GetActiveObject( "Word.Application" )
CATCH
TRY
::oWord := CreateObject( "Word.Application" )
CATCH
Alert( "ERROR! Word no está instaldo en esta PC.")
::lWord := .F.
END
END
RETURN( Self )
METHOD NewDoc( cNombreDoc ) CLASS TWord
DEFAULT cNombreDoc := 'Documento1'
::oDocs := ::oWord:Get( "Documents")
::oDocs:Invoke( "Add" )
::oActiveDoc := ::oWord:Get("ActiveDocument")
::oTexto := ::oWord:Get("Selection")
::oOptions := ::oWord:Get("Options") // Vikthor
::oTables := ::oActiveDoc:Get( "Tables") // Vikthor
::oMailMerge := ::oActiveDoc:Get( "MailMerge") // Vikthor
::cNombreDoc := cNombreDoc
::nLinea := 0
::nCol := 0
::nPage := 0
::nYoffset := 0
::nXoffset := 0
::lstartpag := .t.
::oSelection := ::oWord:SELECTION //::oActiveDoc
::lSetcm := .f.
::lOverflowing := .f.
::nlastrow := 0
::ctextoverflow := ''
RETURN nil
METHOD OpenDoc( cNombreDoc ) CLASS TWord
local sal := .t.
::oDocs := ::oWord:Get( "Documents" )
if file( cNombreDoc )
//::oActiveDoc := ::oWord:Documents:Add(cNombreDoc)
::oActiveDoc := ::oDocs:Invoke( "Open",cNombreDoc )
if valtype(::oActiveDoc) <> 'O'
sal := .f.
endif
else
sal := .f.
endif
::oTexto := ::oWord:Get( "Selection" )
::oOptions := ::oWord:Get("Options") // Vikthor
::oMailMerge := ::oActiveDoc:Get( "MailMerge") // Vikthor
::oTables := ::oActiveDoc:Get( "Tables") // Vikthor
::cNombreDoc := cNombreDoc
::nLinea := 0
::nCol := 0
::nPage := 0
::nYoffset := 0
::nXoffset := 0
::oSelection := ::oWord:SELECTION //::oActiveDoc
::lstartpag := .t.
::lsetcm := .f.
::lOverflowing := .f.
::nlastrow := 0
::ctextoverflow := ''
RETURN sal
METHOD AddImagen( nTop, nLeft, nBottom, nRight, cImagen, alinea, ntipo, nrotacion ) CLASS TWord
::Box(nTop, nLeft, nBottom, nRight, {,,,,,,,cImagen}, alinea, ntipo, nrotacion, .t.)
RETURN nil
METHOD addtabulador(npos, ocuadrotext) CLASS TWord
local otabstop, oParagraphFormat
DEFAULT ocuadrotext := ::oTexto
if ::lsetcm
npos := npos*28.35
endif
oParagraphFormat := oCuadroText:Get( 'ParagraphFormat')
otabstop := oParagraphFormat:Get( 'TabStops')
oTabstop:Invoke('Add',npos)
release oParagraphFormat, otabstop
RETURN nil
METHOD Box( nTop, nLeft, nBottom, nRight, afondo, alinea, ntipo, nrotation, lPicTextured ) CLASS TWord
LOCAL oShapes,oShapBox, oFill, oFillColor, olinea , n
DEFAULT afondo := {}, alinea := {}, ntipo := 1, nrotation := 0, lPicTextured := .f.
::nLastRow := nBottom
if ::lsetcm
nTop := nTop*28.35
nLeft := nLeft*28.35
nBottom := nBottom*28.35
nRight := nRight*28.35
endif
nRight := nRight - nLeft
nBottom := nBottom - nTop
oShapes := ::oSelection:Get( "Shapes" )
oShapBox := oShapes:Invoke( "AddShape",ntipo,nLeft,nTop,nRight,nBottom )
//oShapBox:Set('RelativeHorizontalPosition', 1 ) // No
//oShapBox:Set('RelativeVerticalPosition', 1 ) // No
oFill := oShapBox:Get( "Fill" )
oShapBox:Set('Rotation', nRotation )
for n = 1 to len(afondo)
do case
case n = 1 .and. afondo[n] <> NIL
oFillColor := oFill:Get("ForeColor")
oFillColor:Set( 'RGB', aFondo[1] )
case n = 2 .and. afondo[n] <> NIL
oFillColor := oFill:Get("BackColor")
oFillColor:Set( 'RGB', afondo[2] )
case n = 3 .and. afondo[n] <> NIL
oFillColor:Set( 'Transparency', afondo[3])
case n = 4 .and. afondo[n] <> NIL
oFill:Invoke( 'TwoColorGradient', afondo[4], afondo[5] )
case n = 6 .and. afondo[n] <> NIL
oFill:Invoke( 'Patterned', afondo[6] )
case n = 7 .and. afondo[n] <> NIL
oFill:Invoke( 'PresetTextured', afondo[7] )
case n = 8 .and. afondo[n] <> NIL
if lPicTextured = .t.
oFill:Invoke( 'UserPicture', afondo[8] )
else
oFill:Invoke( 'UserTextured' , afondo[8] )
endif
endcase
next n
oLinea := oShapBox:Get( "Line" )
for n = 1 to len(alinea)
do case
case n = 1
oLinea:Set( "Weight", alinea[1] )
case n = 2
oLinea:Set( "ForeColor", alinea[2] )
case n = 3
oLinea:Set( "BackColor", alinea[3] )
case n = 4
oLinea:Set( "Transparency", alinea[4])
case n = 5
oLinea:Set( "DashStyle", alinea[5] )
case n = 5
oLinea:Set( "Style", alinea[6] )
endcase
next n
release oShapes,oShapBox, oFill, oFillColor, olinea
RETURN nil
METHOD close(oDoc) CLASS TWord
DEFAULT oDoc := ::oActiveDoc
oDoc:Invoke('Close',0)
RETURN NIL
METHOD CmSay( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust ) CLASS TWord
local lsetcm := ::lsetcm
::lSetCm := .t.
::Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nColorIndex, lVertAdjust )
::lSetcm := lsetcm
RETURN Nil
METHOD CheckSpelling() CLASS TWord
::oActiveDoc:Invoke( 'CheckSpelling')
RETURN nil
METHOD End( lSave ) CLASS TWord
Local nOption
DEFAULT lSave := .T.
* ::oDocs:Invoke('Close')
nOption := if( lSave , -1 , 0 )
::oWord:Invoke( "Quit" , nOption )
::oTexto := NIL
::oActiveDoc := NIL
::oDocs := NIL
::oWord := NIL
RETURN nil
METHOD EndPage() CLASS TWord
RETURN nil
METHOD FillRect( aRect, oBrush ) CLASS TWord
LOCAL oShapes,oShapBox, oFill, oFillColor, ocuadro
if ::lsetcm
arect[1] := arect[1]*28.35
arect[2] := arect[2]*28.35
arect[3] := arect[3]*28.35
arect[4] := arect[4]*28.35
endif
oShapes := ::oSelection:Get( "Shapes" )
oShapBox := oShapes:Invoke( "AddShape",1,arect[2],arect[1],arect[4]-arect[2],aRect[3]-arect[1] )
oCuadro:Set( 'RelativeHorizontalPosition',1)
oCuadro:Set( 'RelativeVerticalPosition',1)
oFill := oShapBox:Get( "Fill")
oFillColor := oFill:Get( "ForeColor")
oFillColor:Set( "RGB",oBrush:nRGBColor )
oBrush:End()
release oFillColor,oFill,oShapBox,oShapes
RETURN nil
METHOD GetTextHeight( oFont ) CLASS TWord
local sal
if ::lsetcm
sal := oFont:nHeight/28.35
else
sal := oFont:nHeight
endif
RETURN sal
METHOD GetTextWidth(cText, oFont) CLASS TWord
local nancho
if oFont:nHeight > 0
nancho := (oFont:nHeight/1.6)*len(ctext)
else
nancho :=((oFont:nHeight*-1)/1.6)*len(ctext)
endif
RETURN nancho
METHOD JustificaDoc( nJustify, otext ) CLASS TWord
LOCAL oParagraph
DEFAULT oText := ::oTexto
oParagraph := oText:Get("ParagraphFormat")
* oParagraph:Set( "Alignment", nJustify )
oParagraph:Alignment:= nJustify
RELEASE oParagraph
RETURN ( Nil )
METHOD Line( nTop, nLeft, nBottom, nRight, oPen, nColor, nStyle ) CLASS TWord
local oShapes,oShapLinea, oLinea, oRGB
if ::lsetcm
nTop := nTop*28.35
nLeft := nLeft*28.35
nBottom := nBottom*28.35
nRight := nRight*28.35
endif
if oPen = NIL
DEFINE PEN oPen
if nStyle = Nil
nStyle := 1
endif
if nColor = Nil
nColor := nRGB(0,0,0)
endif
else
if nStyle = Nil
do case
case oPen:nStyle = 0
nStyle := 1
case oPen:nStyle = 1
nStyle := 4
case oPen:nStyle = 2
nstyle := 2
case oPen:nStyle = 3
nstyle := 5
case oPen:nStyle = 4
nstyle := 6
endcase
endif
if nColor = Nil
nColor := oPen:nColor
endif
endif
oShapes := ::oSelection:Get( "Shapes" )
oShapLinea := oShapes:Invoke( "AddLine", nLeft,nTop,nRight,nBottom )
oShapLinea:Set( 'RelativeHorizontalPosition',1)
oShapLinea:Set( 'RelativeVerticalPosition',1)
oLinea := oShapLinea:Get( "Line" )
* oLinea:Set( "Weight", oPen:nWidth-2 ) // No anda OK
oRGB := oLinea:Get( 'ForeColor')
oRGB:Set('RGB', nColor )
oLinea:Set( "DashStyle", nStyle)
oPen:End()
release oLinea,oShapLinea,oShapes, oRGB
RETURN nil
*METHOD nLogPixelX()
* RETURN 55.38
*METHOD nLogPixelY()
* RETURN 55.38
METHOD Preview() CLASS TWord
::oWord:Set( "PrintPreview", .F.)
::oActiveDoc:Invoke( "PrintPreview")
::Visualizar()
RETURN nil
METHOD PrintDoc(lbackground, lappend, nRange, cOutputFile, nfrom, nto, nitem, ncopias, cpages) CLASS TWord
local csinpath, cpath
DEFAULT lbackground := .f., lappend := .f., nRange := 0, cOutputFile := '',;
nfrom := '', nto := '' ,;
nitem := 0, ncopias := 1, cpages := ''
if !empty(nFrom) .or. !empty(nTo)
nRange := 3
nFrom := alltrim(str(int(nFrom)))
nTo := alltrim(str(int(nTo)))
endif
if empty(cOutputFile)
::oActiveDoc:Invoke( "PrintOut" , lbackground,lappend,int(nRange),'',nfrom, nto, nitem,ncopias, cpages )
else
cpath := cFilePath(cOutputFile)
if !empty(cpath) .and. cpath <>'\'
::oWord:Invoke( 'ChangeFileOpenDirectory',cpath)
endif
csinpath := cFileNoPath(cOutputFile)
::oWord:Invoke( "PrintOut",lbackground,lappend,int(nRange),csinpath, nfrom, nto, nitem, ncopias, cpages )
endif
RETURN nil
METHOD Protect(cpassword,nmodo) CLASS TWord
DEFAULT nmodo := 1
::oActiveDoc:Invoke( "Protect", nmodo, .F., cpassword )
RETURN nil
METHOD Replace( cOld, cNew ) CLASS TWord
LOCAL oTexto, oFind, oReplace, lValue
/*
oTexto := ::oSelection:Range()
oFind := oTexto:Get( "Find" )
oFind:Set( "Text", cOld )
oFind:Set( "Forward", .T. )
oFind:Set( "Wrap", INT(1) )
oFind:Set( "Format", .f. )
oFind:Set( "MatchCase", .f. )
oFind:Set( "MatchWholeWord", .f. )
oFind:Set( "MatchWildcards", .f. )
oFind:Set( "MatchSoundsLike", .f. )
oFind:Set( "MatchAllWordForms", .f. )
oFind:Invoke( "Execute")
DO WHILE oFind:Get( "Found" )
oTexto:Set( "Text", cNew )
oFind:Invoke( "Execute")
Enddo
:Format := .f.
:MatchCase := .f.
:MatchWholeWord := .f.
:MatchWildcards := .f.
:MatchSoundsLike := .f.
:MatchAllWordForms := .f.
*/
//Release oReplace,oFind,oTexto
WITH OBJECT ::oSelection:FIND
:TEXT := cOld
:Forward := .T.
:WRAP := 1
END WITH
DO WHILE .t.
TRY
lValue := ::oSelection:FIND:Execute()
CATCH
lValue := .f.
END
IF lValue
::oSelection:Cut()
::oSelection:InsertBefore(cNew)
::oSelection:MoveRight()
Else
Exit
End
ENDDO
RETURN nil
METHOD Save(cnombredoc) CLASS TWord
DEFAULT cnombredoc := ::cNombreDoc
::oActiveDoc:Invoke( "SaveAs", cNombreDoc )
RETURN nil
METHOD Say( nLin,nCol,cTexto,oFuente,nSizeHorz,nClrText,nBkMode,nPad, naltura, nClrIndex, lvertadjust ) CLASS TWord
if oFuente = Nil
DEFINE FONT oFuente NAME 'Arial' SIZE 0, -12 OF Self
endif
DEFAULT nBkMode := 2
DEFAULT nSizeHorz := ::GetTextWidth(ctexto,oFuente)
DEFAULT naltura := if(::lsetcm, 1, 28.35)
if ::lsetcm
nSizeHorz := nSizeHorz/28.35
endif
if nBkMode = 2
nBkMode = 0
else
nBkMode = 1
endif
do case
case npad = 1
ncol := ncol - nSizeHorz
npad := 2
case npad = 2
ncol = ncol - (nSizeHorz/2)
npad := 1
endcase
::TextBox(nLin, nCol, nLin+nAltura, nCol+nSizeHorz, ctexto, oFuente, nClrText, nClrIndex, npad,{,,nPad},{0},lVertAdjust)
RETURN Nil
METHOD Say2( nLin,nCol,cTexto,oFuente, nSize, lBold, lShadow, nColor ) CLASS TWord
local cfuente := oFuente:cFaceName
do whil ::nLinea < nLin
::oTexto:Invoke( "TypeText", chr(13) )
::nlinea := ::nlinea + 1
enddo
::nCol := 0
do whil ::nCol < nCol
::oTexto:Invoke( "TypeText", chr(9) )
::nCol := ::nCol + 1
enddo
::Write( cTexto, cFuente, nSize, lBold, lShadow, nColor )
RETURN nil
METHOD SayGTF( nTop,nLeft, cTextFormat, nBottom,nRight ) CLASS TWord
local cText := "", nPos := 1, nLen := 0, nCrLf, cFormat, cVersion, cType
local afuentes := {}, nColorText := 0
local cFacename, cHeight, cWidth, lBold, lItalic, lUnderline, lStrikeout
local nJustify, nFont, oText
local oShapes, oCuadro, oFill, oLine, oCuadrotext
local oFont := ::oTexto:Get( "Font" )
local aSal := {.f.,''}, lnocabe := .f.
if ::lsetcm
nTop := nTop*28.35
nLeft := nLeft*28.35
nBottom := nBottom*28.35
nRight := nRight*28.35
endif
nLen := AT( SP_REG, SubStr( cTextFormat, nPos ) )
cFormat := SubStr( cTextFormat, nPos, nLen - 1 )
nPos += nLen
nLen := At( SP_FIELD, SubStr( cTextFormat, nPos ) )
cVersion := SubStr( cTextFormat, nPos, nLen - 1 )
nPos += nLen
if !( cFormat == FORMAT_TEXT_TYPE )
asal[1] := .f.
RETURN asal
endif
do whil .t.
if Substr( cTextFormat, npos, 1 ) == SP_FIELD
nPos += 1
exit
endif
cFacename := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
cHeight := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
cWidth := Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
lBold := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.)
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
lItalic := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.)
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
lUnderline := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.)
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
lStrikeOut := if(val(Substr( cTextFormat, npos, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 )) = 0, .f.,.t.)
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
aadd( afuentes, {cFacename, cHeight, cWidth, lBold, lItalic, lUnderline, lStrikeOut})
enddo
oShapes := ::oSelection:Get( "Shapes" )
oCuadro := oShapes:Invoke( "AddTextbox", 1,INT(nLeft),INT(nTop),INT(nRight-nLeft),INT(nBottom-nTop))
oCuadro:Set( 'RelativeHorizontalPosition',1)
oCuadro:Set( 'RelativeVerticalPosition',1)
oFill := oCuadro:Get( "Fill" )
oFill:Set( "Transparency",0)
oFill:Set( "Visible",0)
oLine := oCuadro:Get( "Line" )
oLine:Set( "Transparency",0)
oLine:Set( "Visible",0)
oCuadroText := oCuadro:Get( "TextFrame" )
oText := oCuadroText:Get( "TextRange" )
oCuadro:Invoke('Select')
do while ( cType := SubStr( cTextFormat, nPos, 1 ) ) != SP_FIELD
if cType == TP_ALIGN .or. cType == TP_FONT .or. cType == TP_COLOR
if cType == TP_ALIGN
njustify := Val(Substr( cTextFormat, npos +1, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 ))
::Justificadoc(njustify)
endif
if cType == TP_FONT
nfont := val(SubStr( cTextFormat, nPos + 1, nLen -1 ))
oFont:Set( "Name", afuentes[nfont,1] )
oFont:Set( "Size", if( val(afuentes[nfont,2]) < 0, val(afuentes[nfont,2])*-1, val(afuentes[nfont,2]) ) )
oFont:Set( "Bold", afuentes[nfont,4] )
oFont:Set( "Italic", afuentes[nfont,5] )
oFont:Set( "Underline", afuentes[nfont,6] )
oFont:Set( "StrikeThrough", afuentes[nfont,7] )
endif
if cType == TP_COLOR
ncolortext := Val(Substr( cTextFormat, npos +1, At( SP_REG, Substr( cTextFormat, nPos ) ) -1 ))
oFont:Set( "Color", ncolortext )
endif
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nPos += nLen
else
nLen := At( SP_REG, SubStr( cTextFormat, nPos ) )
nCrLf := At( CRLF, SubStr( cTextFormat, nPos ) )
if nLen == 0
if nCrLf == 0
nLen := At( SP_FIELD, SubStr( cTextFormat, nPos ) ) - 1
else
nLen := nCrLf + 1
endif
else
if nCrLf == 0 .or. nCrLf > nLen
do while SubStr( ctextformat, nPos + --nLen - 1, 1 ) > Chr( 32 )
enddo
--nLen
else
nLen := nCRLf + 1
endif
endif
cText = SubStr( cTextFormat, nPos, nLen )
::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.)
lnocabe := oCuadroText:Get( 'Overflowing')
if lnocabe
asal[2] := substr( ctextformat,1, 4 )
asal[2] := asal[2] + substr( ctextformat, 5, At( SP_FIELD, Substr( cTextformat, 5) ))
asal[2] := asal[2] + substr( ctextformat, nPos + nLen)
exit
endif
cText = SubStr( cTextFormat, nPos, nLen )
::oTexto:Invoke( "Typetext", cText )
nPos += nLen
endif
enddo
oFont:Invoke( "Reset" )
release oShapes, oCuadro, oFill, oLine, oCuadrotext, oFont
RETURN asal
METHOD SetCm() CLASS TWord
::lSetCm := .t.
RETURN NIL
METHOD SetHeader() CLASS TWord
local oWindow := ::oActiveDoc:Get( "ActiveWindow" )
local oView := oWindow:Get( "View")
oView:Set( "SeekView" , 10 ) // 9 Header 10 Footer
::oSelection := ::oTexto:Get( "HeaderFooter")
release oWindow, oView
RETURN nil
METHOD SetLandScape() CLASS TWord
local oPageSetup := ::oActiveDoc:Get( 'PageSetup')
oPageSetup:Set( 'Orientation','1')
release oPageSetup
RETURN nil
METHOD SetMainDoc() CLASS TWord
local oWindow := ::oActiveDoc:Get( "ActiveWindow" )
local oView := oWindow:Get( "View")
oView:Set( "SeekView" , 0 )
::oSelection := ::oActiveDoc
release oWindow, oView
RETURN nil
METHOD SetPortrait() CLASS TWord
local oPageSetup := ::oActiveDoc:Get( 'PageSetup')
oPageSetup:Set( 'Orientation','0')
release oPageSetup
RETURN nil
METHOD SetUl() CLASS TWord
::lSetCm := .f.
RETURN NIL
METHOD StartPage() CLASS TWord
if ::lstartpag = .t.
::lstartpag := .f.
else
::oTexto:Invoke( "EndKey" , 6 , 0 )
::oTexto:Invoke( "InsertBreak" )
::oTexto:Invoke( "GotoNext" , 1 )
::nPage++
::nLinea:=0
::nCol :=0
endif
::Write(chr(31)) //Es necesario para ponder vincular los cuadros de texto a una pagina determinada.
RETURN nil
METHOD TabClearAll(ocuadrotext) CLASS TWord
local oparagraphformat, otabstop
DEFAULT ocuadrotext := ::oTexto
oParagraphformat := oCuadroText:Get( 'ParagraphFormat')
oTabstop := oParagraphformat:Get( 'TabStops')
oTabstop:Invoke('ClearAll')
release oparagraphformat, otabstop
RETURN nil
METHOD TabPredeterminado(ncada) CLASS TWord
if ::lsetcm
ncada := ncada*28.35
endif
::oActiveDoc:Set( 'DefaultTabStop', ncada )
RETURN nil
METHOD TextBox( nTop, nLeft, nBottom, nRight, cTexto, oFuente, nclrtext, nClrBack, nJustify, afondo, alinea, lvertadjust, norientacion) CLASS TWord
local oShapes,oCuadro,oFill,oLinea, oFontC, oText, oCuadroText, oFillColor, oParagraph, lCorta
local nPad := 0, n, oWrap, nheighttext,;
lnocabe := .f., nheightbox:= 0,;
cTexto2
DEFAULT nTop := 0, nLeft := 0, nBottom := 10, nRight := 10,;
cTexto := ' ', oFuente := TFont():New(),;
nClrText := nRGB(0,0,0), nJustify := 0,;
afondo := {}, alinea := {}, lvertadjust := .f.,;
norientacion := 1
nheighttext := oFuente:nHeight
if norientacion > 3
norientacion := 1
endif
do case
case nJustify = 1
nPad := 2
case nJustify = 2
nPad := 1
case nJustify = 6
nPad := 0
endcase
if ::lsetcm
nTop := nTop*28.35
nLeft := nLeft*28.35
nBottom := nBottom*28.35
nRight := nRight*28.35
endif
oShapes := ::oSelection:Get( "Shapes" )
oCuadro := oShapes:Invoke( "AddTextbox", norientacion,INT(nLeft),INT(nTop),INT(nRight-nLeft),INT(nBottom-nTop) )
oFill := oCuadro:Get( "Fill" )
oCuadro:Set( 'RelativeHorizontalPosition',1)
oCuadro:Set( 'RelativeVerticalPosition',1)
//Fill
for n = 1 to len(afondo)
do case
case n = 1 .and. afondo[n] <> NIL
oFillColor := oFill:Get( "ForeColor")
oFillColor:Set( 'RGB', afondo[1] )
case n = 2 .and. afondo[n] <> NIL
oFillColor := oFill:Get( "BackColor")
oFillColor:Set( 'RGB', afondo[2] )
case n = 3 .and. afondo[n] <> NIL
oFill:Set( 'Transparency', afondo[3])
case n = 4 .and. afondo[n] <> NIL
oFill:Invoke( 'TwoColorGradient', afondo[4], afondo[5] )
case n = 6 .and. afondo[n] <> NIL
oFill:Invoke( 'Patterned', afondo[6] )
case n = 7 .and. afondo[n] <> NIL
oFill:Invoke( 'PresetTextured', afondo[7] )
case n = 8 .and. afondo[n] <> NIL
oFill:Invoke( 'UserTextured' , afondo[8] )
endcase
next n
//Linea de contorno
oLinea := oCuadro:Get( "Line" )
oLinea:Set( "Transparency", 1 ) // EBM
for n = 1 to len(alinea)
do case
case n = 1
oLinea:Set( "Weight", alinea[1] )
case n = 2
oLinea:Set( "ForeColor", alinea[2] )
case n = 3
oLinea:Set( "BackColor", alinea[3] )
case n = 4
oLinea:Set( "Transparency", alinea[4])
case n = 5
oLinea:Set( "DashStyle", alinea[5] )
case n = 5
oLinea:Set( "Style", alinea[6] )
endcase
next n
oCuadroText := oCuadro:Get( "TextFrame" )
oText := oCuadroText:Get( "TextRange" )
oFontC := oText:Get( "Font")
oFontC:Set( "Name" , oFuente:cFaceName )
oFontC:Set( "Size" , INT(oFuente:nHeight) )
oFontC:Set( "Bold" , oFuente:lBold )
oFontC:Set( "Color" , nclrtext )
oText:Set( 'HighlightColorIndex', nClrBack )
oText:Set( "Text", cTexto )
oParagraph := oText:Get( "ParagraphFormat")
* oParagraph:Set( "Alignment", nPad )
oParagraph:Alignment := nPad
if lvertadjust
nheightbox := 0
oCuadro:Set( 'Height', nheightbox)
::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.)
lnocabe := oCuadroText:Get( 'Overflowing')
nheightbox := nheightbox + nHeighttext //+ OleGetProperty(oParagraph,'SpaceBefore')
do whil lnocabe = .t. .and. nheightbox <= nBottom - nTop
oCuadro:Set( 'Height', nheightbox)
oText:Set( "Text", cTexto )
::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.)
lnocabe := oCuadroText:Get( 'Overflowing')
nheightbox := nheightbox + nHeighttext //+ OleGetProperty(oParagraph,'SpaceBefore')
enddo
else
::oActiveDoc:Invoke( 'ComputeStatistics',2,.t.)
lnocabe := oCuadroText:Get( 'Overflowing')
nheightbox := nBottom
endif
lcorta := lnocabe
ctexto2 := ctexto
do whil lcorta .and. !empty(ctexto2)
ctexto2 := Dellastword(ctexto2)
oText:Set( 'Text', ctexto2)
::oActiveDoc:Invoke('ComputeStatistics',2,.t.)
lcorta := oCuadroText:Get( 'Overflowing')
enddo
::ctextoverflow := strtran(ctexto, ctexto2, '')
::loverflowing := lnocabe
::oLastSay := otext
release oParagraph, OLinea, oFillColor, oFill, oFontC, oText,oCuadroText, oCuadro
if ::lsetcm
::nlastrow := nBottom/28.35
else
::nlastrow := nBottom
endif
RETURN Nil
METHOD UnProtect(cpassword) CLASS TWord
::oActiveDoc:Invoke( "UnProtect", cpassword )
RETURN nil
METHOD VistaCompleta() CLASS TWord
LOCAL oWindow, oView
oWindow := ::oActiveDoc:Get( "ActiveWindow" )
oView := oWindow:Get( "View" )
oView:Set( "FullScreen", .T. )
::Visualizar()
release oView
RETURN nil
METHOD Write( cTexto, cFuente, nSize, lBold, lShadow, nColor ) CLASS TWord
LOCAL oFont := ::oTexto:Get("Font")
oFont:Set( "Name", cFuente )
oFont:Set( "Size", nSize )
oFont:Set( "Bold", lBold )
oFont:Set( "Emboss", lShadow )
oFont:Set( "Color", nColor )
::oTexto:Invoke( "TypeText", cTexto )
oFont:Invoke( "Reset" )
RELEASE oFont
RETURN( Nil )
static function dellastword(ctexto)
LOCAL sal
sal := rtrim(ctexto)
do whil !empty(sal)
sal := substr(sal,1, len(sal)-1)
if substr(sal, len(sal), 1) = chr(32) .or. substr(sal, len(sal), 1) = chr(13)
exit
endif
enddo
RETURN sal
METHOD SendMail( lAttach ) CLASS TWord // [ Vikthor ]
DEFAULT lAttach := .T.
::oOptions:Set( "SendMailAttach" , lAttach )
::oActiveDoc:Invoke( "SendMail" )
RETURN Self
METHOD HeaderFooter( nOption ) CLASS TWord // Vikthor
/*
wdSeekCurrentPageFooter 10
wdSeekCurrentPageHeader 9
wdSeekEndnotes 8
wdSeekEvenPagesFooter 6
wdSeekEvenPagesHeader 3
wdSeekFirstPageFooter 5
wdSeekFirstPageHeader 2
wdSeekFootnotes 7
wdSeekMainDocument 0
wdSeekPrimaryFooter 4
wdSeekPrimaryHeader 1
*/
LOCAL oWindow := ::oActiveDoc:Get( "ActiveWindow" )
LOCAL oView := oWindow:Get( "View" )
DEFAULT nOption := 9
oView:Set( "SeekView", nOption )
IF( nOption == 0 , ;
::oSelection := ::oActiveDoc , ; // Graba los datos al Documento
::oSelection := ::oTexto:Get( "HeaderFooter") ) // Abre el metodo para escritura
release oWindow, oView
RETURN( Nil )
METHOD OpenDataSource( cFile ) CLASS TWord // Vikthor
LOCAL oDField
LOCAL cText, nItem , i , oRange
DEFAULT cFile := "file.xls"
::oMailMerge:Invoke( 'OpenDataSource' , cFile , 0 , .F. )
::oDataSource := ::oMailMerge:Get("DataSource") // Regresa el Objeto MailMergeDataSource
::oDataFields := ::oDataSource:Get("DataFields") // Regresa el Objeto MailMergeDataFields
::oFields := ::oMailMerge:Get("Fields") // Regresa el Objeto MailMergeFields
/*
cText := "Hay "
nItem := ::oDataFields:Count() // Devuelve _ hay
cText += Ltrim(Str( nItem )) + " campos para combinar correspondecia "+ CRLF + CRLF
FOR i := 1 TO nItem
oDField := ::oDataFields:Item( i ) // Regresa el Objeto MailMergeDataField
cText += Str( i ) + ".-"+ oDField:Name() + CRLF
NEXT
::Write( chr(13)+chr(13)+ cText )
*/
RETURN( Nil )
METHOD AddField( cField , cFuente, nSize, lBold, lShadow, nColor , nEnd ) CLASS TWord // Vikthor
LOCAL oRange := ::oSelection:Range()
LOCAL oFont
* LOCAL nEnd := oRange:Get("End")
DEFAULT nEnd := oRange:Get("End")
oRange:SetRange( nEnd , nEnd )
oFont := oRange:Get("Font")
DEFAULT cFuente := "Tahoma" ,;
nSize := 10 ,;
lBold := .F. ,;
lShadow := .F. ,;
nColor := 0
oFont:Set( "Name", cFuente )
oFont:Set( "Size", nSize )
oFont:Set( "Bold", lBold )
oFont:Set( "Emboss", lShadow )
oFont:Set( "Color", nColor )
::oFields:Invoke("Add", oRange , cField )
oFont:Invoke( "Reset" )
RELEASE oFont , oRange
RETURN( Nil )
METHOD AddTables( aDatos , nPos , aCols ) CLASS TWord // Vikthor
LOCAL oRange := ::oSelection:Range()
LOCAL oTable , oCell , oCellRange , oCells
LOCAL nRows , nCols, oSelection, oColumns
LOCAL x , y, aAlign, oFont, oCol, oParagraph
nRows:=Len( aDatos )
nCols:=Len( aDatos[1] )
aAlign := aCols
oRange:SetRange( nPos , nPos )
oTable:= ::oTables:Invoke("Add", oRange , nRows , nCols )
FOR x := 1 TO nRows
FOR y := 1 TO nCols
oCell := oTable:Cell( x , y)
oCellRange := oCell:Range()
oCellRange:Invoke( 'InsertAfter' , aDatos[x,y] )
SysRefresh()
NEXT
NEXT
oColumns:=oTable:Columns:Select()
oSelection:= ::oWord:Get("Selection")
oFont:=oSelection:Font()
oFont:Name:='Tahoma'
oFont:Size:=9
oColumns:=oTable:Columns:AutoFit()
oCol:=oTable:Columns:Item(3)
oCol:Select()
oSelection:= ::oWord:Get("Selection")
oFont:=oSelection:Font()
oFont:Name:='Tahoma'
oFont:Size:=9
FOR x := 1 TO nCols // Len( aDatos )
oCol:=oTable:Columns:Item(x)
oCol:Select()
oParagraph := oSelection:Get("ParagraphFormat")
* oParagraph:Set( "Alignment", 2 )
oParagraph:Alignment := aAlign[ x ]
SysRefresh()
NEXT
oTable:AutoFormat(1)
RETURN( oTable )
METHOD View( nView ) CLASS TWord // Vikthor
local oWindow := ::oActiveDoc:Get( "ActiveWindow" )
local oView := oWindow:Get( "View")
oView:Set( "Type" , nView )
release oWindow, oView
RETURN ( Nil )
METHOD Zoom( nPercent ) CLASS TWord // Vikthor
local oWindow := ::oActiveDoc:Get( "ActiveWindow" )
local oView := oWindow:Get( "View")
DEFAULT nPercent := 100
oView:Set( "Zoom" , nPercent )
release oWindow, oView
RETURN ( Nil )
METHOD Find( cText ) CLASS TWord // Vikthor
LOCAL oTexto, oFind, nEnd := 0
oTexto := ::oSelection:Range()
oFind := oTexto:Get( "Find" )
oFind:Set( "Text", cText )
oFind:Set( "Forward", .T. )
oFind:Set( "Wrap", INT(1) )
oFind:Set( "Format", .f. )
oFind:Set( "MatchCase", .f. )
oFind:Set( "MatchWholeWord", .f. )
oFind:Set( "MatchWildcards", .f. )
oFind:Set( "MatchSoundsLike", .f. )
oFind:Set( "MatchAllWordForms", .f. )
oFind:Invoke( "Execute")
DO WHILE oFind:Get( "Found" )
oTexto:Set( "Text", "" )
oFind:Invoke( "Execute")
nEnd := oTexto:Get("End")
Enddo
Release oTexto , oFind
RETURN( nEnd )
METHOD ChangeField( cText , cNameField ) CLASS TWord // Vikthor
LOCAL oTexto, oFind, nEnd := 0
oTexto := ::oSelection:Range()
oFind := oTexto:Get( "Find" )
oFind:Set( "Text", cText )
oFind:Set( "Forward", .T. )
oFind:Set( "Wrap", INT(1) )
oFind:Set( "Format", .f. )
oFind:Set( "MatchCase", .f. )
oFind:Set( "MatchWholeWord", .f. )
oFind:Set( "MatchWildcards", .f. )
oFind:Set( "MatchSoundsLike", .f. )
oFind:Set( "MatchAllWordForms", .f. )
oFind:Invoke( "Execute")
DO WHILE oFind:Get( "Found" )
oTexto:Set( "Text", "" )
nEnd := oTexto:Get("End")
IF nEnd > 0
::AddField( cNameField , , , , , , nEnd )
ENDIF
oFind:Invoke( "Execute")
ENDDO
Release oTexto , oFind
RETURN( Nil )
Carlos
Re: Combinar correspondencia en WORD
Carlos:
Muchas gracias, voy a intentarlo y paso reporte.
Saludos
Muchas gracias, voy a intentarlo y paso reporte.
Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
Re: Combinar correspondencia en WORD
Estimado Armando
Tu plantilla WORD tenés que guardarla en formato .RTF
Y colocar en el documento tus campos asi: [NOMBRE]
y desde tu programa reemplazar
Tu plantilla WORD tenés que guardarla en formato .RTF
Y colocar en el documento tus campos asi: [NOMBRE]
y desde tu programa reemplazar
Code: Select all
cTxtFile:=DOCS.RTF
cTxtFile:= STRTRAN(cTxtFile, "[NOMBRE]",oSQL:NOMBRE)
Saludos,
Adhemar C.
Adhemar C.
Re: Combinar correspondencia en WORD
Ademar:
Muchas gracias, con el ejemplo de Carlos funcionó de 100, gracias a ambos.
Por cierto, recuerdo que había un .DOC con la explicación de cómo funciona la TWORD
alguien lo tiene y quiere compartirlo?.
Saludos
Muchas gracias, con el ejemplo de Carlos funcionó de 100, gracias a ambos.
Por cierto, recuerdo que había un .DOC con la explicación de cómo funciona la TWORD
alguien lo tiene y quiere compartirlo?.
Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
Re: Combinar correspondencia en WORD
Hola Armando.
Yo uso archivos con extensión DOC y DOCX, con variables que se reemplazan con datos de archivos.
Si necesitas ver como lo hago, me avisas.
Saludos
Antonio
Yo uso archivos con extensión DOC y DOCX, con variables que se reemplazan con datos de archivos.
Si necesitas ver como lo hago, me avisas.
Saludos
Antonio
Re: Combinar correspondencia en WORD
Estimados(as)
El siguiente documento Word:
y don(ña) [nomcli], cédula de identidad N°[rutcli], domiciliado(a) en [dircli],
Es llenado por:
oWord:Replace( '[nomcli]', " " + oRsCli:nombres )
oWord:Replace( '[rutcli]', oRsCli:Rut )
oWord:Replace( '[dircli]', " " + oRsCli:Domicilio )
Agrego un espacio para que separe el dato del texto que lo antecede.
No agrega el texto con el tipo de letra del documento Word,
¿Cómo soluciono esto
El siguiente documento Word:
y don(ña) [nomcli], cédula de identidad N°[rutcli], domiciliado(a) en [dircli],
Es llenado por:
oWord:Replace( '[nomcli]', " " + oRsCli:nombres )
oWord:Replace( '[rutcli]', oRsCli:Rut )
oWord:Replace( '[dircli]', " " + oRsCli:Domicilio )
Agrego un espacio para que separe el dato del texto que lo antecede.
No agrega el texto con el tipo de letra del documento Word,
¿Cómo soluciono esto
Luis Antonio GM
Curicó-Chile
Curicó-Chile
Re: Combinar correspondencia en WORD
Hola Luis:
En mis pruebas todo funciona de 100.
Saludos
En mis pruebas todo funciona de 100.
Saludos
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero