mkyx Posted March 3, 2010 Report Share Posted March 3, 2010 Alguém do forum sabe explicar porque quando executar o programa que ler e alterar um documento do word .doc, dá o erro: Class: ´NIL´ has no exported method: INVOKE Esse erro ocorre na linha seguinte ao da função method save(cNombreDoc) class TWord a seguir o programa e a classe tword, que compilo junto: Desde já agradeço a todos. #include "fivewin.ch" // Gera array com o texto para tWord function main() PRIVATE aCampos := {} AADD(aCampos,{"[RAZAOSOCIAL]","Kosmos Comercial Ltda Rua Dr. Morais Filho 50 - Centro"}) AADD(aCampos,{"[CNPJ_CEI]","45.456.556/0001-20"}) AADD(aCampos,{"[TOMADOR]",SPACE(10)}) GeraTword(aCampos) RETURN .T. ***************************************** STATIC FUNCTION GeraTword(aCampos) // CAMIFO) local x, cARQDOC := "TESTE.doc" oWord := TWord():New() // inicia o objeto OLE Word cDEST:="RET_RRR.DOC" COPYFILE(cARQDOC ,cDEST,.F.) if oWord:IsVisible() **oWord:Hide() endif TRY oWord:OpenDoc( cDEST ) // abre o documento modelo FOR x=1 to len( aCampos ) oWord:Replace( aCampos[x,1], aCampos[x,2] ) NEXT CATCH oError // E avisamos ao usuario o motivo do erro! Alert( oError:description ) End oWord:Save(CDEST) // CAMIFO) oWord:PREVIEW() //oWord:visualiza() //oWord:Printdoc(.F.) oWord:End() RETURN(.T.) ************************************************************ // classe twordhb // 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. */ #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 Combinar( cWildCards ) 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 AddBar(aDatos) 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 ] ENDCLASS 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 := nnpos*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 ) else oFill:Invoke( 'UserTextured' , afondo ) 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", alineas[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 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() CLASS TWord ::oDocs:Invoke('Close') ::oWord:Invoke( "Quit",0) ::oTexto := NIL ::oActiveDoc := NIL ::oDocs := NIL ::oWord := NIL #IFNDEF __XHARBOUR__ OleUninitialize() #ENDIF RETURN nil METHOD EndPage() CLASS TWord RETURN nil METHOD FillRect( aRect, oBrush ) CLASS TWord LOCAL oShapes,oShapBox, oFill, oFillColor 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 ) 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 NEW() CLASS TWord ::lWord := .T. #IFDEF __XHARBOUR__ 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 #ELSE ::oWord := TOleAuto():New("Word.Application") IF ::oWord:hObj == 0 Alert( "ERROR! Word no está instaldo en esta PC.") ::lWord := .F. ENDIF #ENDIF 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 := ::oActiveDoc ::lSetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN nil *METHOD nLogPixelX() * RETURN 55.38 *METHOD nLogPixelY() * RETURN 55.38 METHOD OpenDoc( cNombreDoc ) CLASS TWord local sal := .t. ::oDocs := ::oWord:Get( "Documents" ) if file( 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 := ::oActiveDoc ::lstartpag := .t. ::lsetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN sal 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 //::oSelection := ::oActiveDoc // Vikthor 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" ) // Reemplaza todas las ocurrencias que coincidan oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil METHOD Combinar( cOld, cNew ) CLASS TWord LOCAL oTexto, oFind, oReplace LOCAL cFound, x_pos //::oSelection := ::oActiveDoc // Vikthor 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", .t. ) oFind:Set( "MatchSoundsLike", .f. ) oFind:Set( "MatchAllWordForms", .f. ) oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) // Reemplaza todas las ocurrencias que coincidan cFound:=Alltrim(SubStr(oTexto:Text,2,Len(Alltrim(oTexto:Text))-2)) //Extrae el nombre de los campos //cNew := search_tab(cFound) //? cNew oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil /* METHOD Combinar( cWildCards , cNew) CLASS TWord //Busca todas las ocurrencias con comodines LOCAL oTexto, oFind, oReplace //::oSelection := ::oActiveDoc // Vikthor oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) //oFind:Set("ClearFormatting") //Quita todos los formatos especificados como parte de una operación de búsqueda y sustitución. oFind:Set( "Text", cWilCards ) oFind:Set( "Forward", .T. ) //True para buscar hacia abajo es decir hacia el final del documento. oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento. oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") //Ejecuta la operación de busqueda especÃfica. Devuelve true si la operación de busqueda tuvo éxito. DO WHILE oFind:Get( "Found" ) //Objeto Find: True si la búsqueda produce una coincidencia. Antes hay que ejecutar el comando find. /* */ // oTexto:Set( "ReplaceWith", "Encontrado") // oTexto:Set( "Text", cNew ) // oFind:Invoke( "Execute") // Enddo // Release oReplace,oFind,oTexto // 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 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 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 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 local nPad := 0, n, oWrap, nheighttext,; lnocabe := .f., nheightbox:= 0 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 ) endcase next n //Linea de contorno oLinea := oCuadro: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", alineas[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 ) 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) 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 /****** * Adjunta un origen de datos al documento especificado, que se convierte en documento principal si aún no lo es. * : Nombre del archivo del origen de datos ******/ 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 cuantos campos 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 ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL nEnd := oRange:Get("End") LOCAL oFont 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 ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL oTable , oCell , oCellRange , oCells LOCAL nRows , nCols LOCAL x , y nRows:=Len( aDatos ) nCols:=Len( aDatos[1] ) 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 ) SysRefresh() NEXT oTable:AutoFormat(1) RETURN( oTable ) METHOD AddBar( cName, Position, MenuBar, Temporary ) /*************** * * Crea una nueva barra de comandos y la agrega a la colección de barras de comandos. * : Variant opcional. Nombre de la nueva barra de comandos. Si se omite este argumento, Word asignará un nombre predeterminado a la barra de comandos, por ejemplo, Custom 1. * : Variant opcional. Posición o tipo de la nueva barra de comandos. * Puede ser una de las constantes MsoBarPosition que aparecen en la siguiente tabla: * - msoBarLeft, msoBarTop, msoBarRight, msoBarBottom Indica las coordenadas izquierda, derecha, superior e inferior de la nueva barra de comandos. * - msoBarFloating Indica que la nueva barra de comandos no estará acoplada. * - msoBarPopup Indica que la nueva barra de comandos será un menú contextual. * - msoBarMenuBar Sólo para Macintosh. * : Variant opcional. True para reemplazar la barra de menú activa con la nueva barra de comandos. El valor predeterminado es False. * : Variant opcional. True para que la nueva barra de comandos sea temporal. Las barras de comandos temporales se eliminan al cerrar la aplicación contenedora. El valor predeterminado es False. ***************/ LOCAL oCommandBar:= oWord:Get( "CommandBars" ) //LOCAL oNewButton := oWord:Get( "CommandBarsButton") oCommandBar:Set("Name",cName) oCommandBar:Set("Position", msoBarFloting) oCommandBar:Set("MenuBar",.f.) oCommandBar:Set("Temporary", .t.) RETURN( Nil ) 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 oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) oFind:Set("ClearFormatting") oFind:Set( "Text", cText ) oFind:Set( "Forward", .T. ) oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) oTexto:Set( "Text",cText ) oFind:Invoke( "Execute") Enddo nEnd := oTexto:Get("End") Release oTexto , oFind RETURN( nEnd ) ********************************* STATIC 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 RETU cChar ******************************** Function sBreak(o,c,x,lShowAlert,lQuit) DEFAULT c:="ERROR",x:="",lQuit:=.f. IF lShowAlert=NIL MsgStop(If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation),c) ENDIF IF lQuit MemoWrit("Error.log",If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation)) QUIT ENDIF BREAK RETU NIL ******************************** Function V(x) LOCAL y:=ValType(x),cRetu:="" DO CASE CASE y=="C" ; RETU x CASE y=="M" ; RETU x CASE y=="N" ; RETU If(Empty(x),"",LTrim(Str(x))) CASE y=="D" ; RETU If(Empty(x),"",DtoC(x)) CASE y=="A" ; RETU (AEval(x,{|a|cRetu+=RTrim(V(a))+","}),SubStr(cRetu,1,Len(cRetu)-1)) CASE y=="L" ; RETU If(x,".T.",".F.") CASE y=="U" ; RETU "_NIL_!" CASE y=="B" ; RETU V({Eval(x)}) CASE y=="O" ; RETU "_OBJECT_!" OTHER ; RETU "?" ENDCASE RETU x Pompeo Guaratinguetá - SP (12) 9777-9386 E-Mail: mkyx@ig.com.br MSN: mkyx@ig.com.br Skype: pardes.mky www.adentech.com.br www.rmahost.com xH 1.1.0 Hb 8.02 - BCC 55 Quote Link to comment Share on other sites More sharing options...
mkyx Posted March 3, 2010 Author Report Share Posted March 3, 2010 Alguém do forum sabe explicar porque quando executar o programa que ler e alterar um documento do word .doc, dá o erro: Class: ´NIL´ has no exported method: INVOKE Esse erro ocorre na linha seguinte ao da função method save(cNombreDoc) class TWord a seguir o programa e a classe tword, que compilo junto: Desde já agradeço a todos. #include "fivewin.ch" // Gera array com o texto para tWord function main() PRIVATE aCampos := {} AADD(aCampos,{"[RAZAOSOCIAL]","Kosmos Comercial Ltda Rua Dr. Morais Filho 50 - Centro"}) AADD(aCampos,{"[CNPJ_CEI]","45.456.556/0001-20"}) AADD(aCampos,{"[TOMADOR]",SPACE(10)}) GeraTword(aCampos) RETURN .T. ***************************************** STATIC FUNCTION GeraTword(aCampos) // CAMIFO) local x, cARQDOC := "TESTE.doc" oWord := TWord():New() // inicia o objeto OLE Word cDEST:="RET_RRR.DOC" COPYFILE(cARQDOC ,cDEST,.F.) if oWord:IsVisible() **oWord:Hide() endif TRY oWord:OpenDoc( cDEST ) // abre o documento modelo FOR x=1 to len( aCampos ) oWord:Replace( aCampos[x,1], aCampos[x,2] ) NEXT CATCH oError // E avisamos ao usuario o motivo do erro! Alert( oError:description ) End oWord:Save(CDEST) // CAMIFO) oWord:PREVIEW() //oWord:visualiza() //oWord:Printdoc(.F.) oWord:End() RETURN(.T.) ************************************************************ // classe twordhb // 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. */ #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 Combinar( cWildCards ) 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 AddBar(aDatos) 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 ] ENDCLASS 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 := nnpos*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 ) else oFill:Invoke( 'UserTextured' , afondo ) 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", alineas[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 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() CLASS TWord ::oDocs:Invoke('Close') ::oWord:Invoke( "Quit",0) ::oTexto := NIL ::oActiveDoc := NIL ::oDocs := NIL ::oWord := NIL #IFNDEF __XHARBOUR__ OleUninitialize() #ENDIF RETURN nil METHOD EndPage() CLASS TWord RETURN nil METHOD FillRect( aRect, oBrush ) CLASS TWord LOCAL oShapes,oShapBox, oFill, oFillColor 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 ) 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 NEW() CLASS TWord ::lWord := .T. #IFDEF __XHARBOUR__ 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 #ELSE ::oWord := TOleAuto():New("Word.Application") IF ::oWord:hObj == 0 Alert( "ERROR! Word no está instaldo en esta PC.") ::lWord := .F. ENDIF #ENDIF 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 := ::oActiveDoc ::lSetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN nil *METHOD nLogPixelX() * RETURN 55.38 *METHOD nLogPixelY() * RETURN 55.38 METHOD OpenDoc( cNombreDoc ) CLASS TWord local sal := .t. ::oDocs := ::oWord:Get( "Documents" ) if file( 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 := ::oActiveDoc ::lstartpag := .t. ::lsetcm := .f. ::lOverflowing := .f. ::nlastrow := 0 ::ctextoverflow := '' RETURN sal 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 //::oSelection := ::oActiveDoc // Vikthor 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" ) // Reemplaza todas las ocurrencias que coincidan oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil METHOD Combinar( cOld, cNew ) CLASS TWord LOCAL oTexto, oFind, oReplace LOCAL cFound, x_pos //::oSelection := ::oActiveDoc // Vikthor 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", .t. ) oFind:Set( "MatchSoundsLike", .f. ) oFind:Set( "MatchAllWordForms", .f. ) oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) // Reemplaza todas las ocurrencias que coincidan cFound:=Alltrim(SubStr(oTexto:Text,2,Len(Alltrim(oTexto:Text))-2)) //Extrae el nombre de los campos //cNew := search_tab(cFound) //? cNew oTexto:Set( "Text", cNew ) oFind:Invoke( "Execute") Enddo Release oReplace,oFind,oTexto RETURN nil /* METHOD Combinar( cWildCards , cNew) CLASS TWord //Busca todas las ocurrencias con comodines LOCAL oTexto, oFind, oReplace //::oSelection := ::oActiveDoc // Vikthor oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) //oFind:Set("ClearFormatting") //Quita todos los formatos especificados como parte de una operación de búsqueda y sustitución. oFind:Set( "Text", cWilCards ) oFind:Set( "Forward", .T. ) //True para buscar hacia abajo es decir hacia el final del documento. oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento. oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") //Ejecuta la operación de busqueda especÃfica. Devuelve true si la operación de busqueda tuvo éxito. DO WHILE oFind:Get( "Found" ) //Objeto Find: True si la búsqueda produce una coincidencia. Antes hay que ejecutar el comando find. /* */ // oTexto:Set( "ReplaceWith", "Encontrado") // oTexto:Set( "Text", cNew ) // oFind:Invoke( "Execute") // Enddo // Release oReplace,oFind,oTexto // 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 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 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 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 local nPad := 0, n, oWrap, nheighttext,; lnocabe := .f., nheightbox:= 0 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 ) endcase next n //Linea de contorno oLinea := oCuadro: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", alineas[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 ) 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) 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 /****** * Adjunta un origen de datos al documento especificado, que se convierte en documento principal si aún no lo es. * : Nombre del archivo del origen de datos ******/ 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 cuantos campos 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 ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL nEnd := oRange:Get("End") LOCAL oFont 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 ) CLASS TWord // Vikthor LOCAL oRange := ::oSelection:Range() LOCAL oTable , oCell , oCellRange , oCells LOCAL nRows , nCols LOCAL x , y nRows:=Len( aDatos ) nCols:=Len( aDatos[1] ) 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 ) SysRefresh() NEXT oTable:AutoFormat(1) RETURN( oTable ) METHOD AddBar( cName, Position, MenuBar, Temporary ) /*************** * * Crea una nueva barra de comandos y la agrega a la colección de barras de comandos. * : Variant opcional. Nombre de la nueva barra de comandos. Si se omite este argumento, Word asignará un nombre predeterminado a la barra de comandos, por ejemplo, Custom 1. * : Variant opcional. Posición o tipo de la nueva barra de comandos. * Puede ser una de las constantes MsoBarPosition que aparecen en la siguiente tabla: * - msoBarLeft, msoBarTop, msoBarRight, msoBarBottom Indica las coordenadas izquierda, derecha, superior e inferior de la nueva barra de comandos. * - msoBarFloating Indica que la nueva barra de comandos no estará acoplada. * - msoBarPopup Indica que la nueva barra de comandos será un menú contextual. * - msoBarMenuBar Sólo para Macintosh. * : Variant opcional. True para reemplazar la barra de menú activa con la nueva barra de comandos. El valor predeterminado es False. * : Variant opcional. True para que la nueva barra de comandos sea temporal. Las barras de comandos temporales se eliminan al cerrar la aplicación contenedora. El valor predeterminado es False. ***************/ LOCAL oCommandBar:= oWord:Get( "CommandBars" ) //LOCAL oNewButton := oWord:Get( "CommandBarsButton") oCommandBar:Set("Name",cName) oCommandBar:Set("Position", msoBarFloting) oCommandBar:Set("MenuBar",.f.) oCommandBar:Set("Temporary", .t.) RETURN( Nil ) 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 oTexto := ::oSelection:Range() oFind := oTexto:Get( "Find" ) oFind:Set("ClearFormatting") oFind:Set( "Text", cText ) oFind:Set( "Forward", .T. ) oFind:Set( "Wrap", INT(1) ) //Establece lo que ocurre si la búsqueda se inicia en un punto distinto al principio del documento oFind:Set( "Format", .f. ) //Devuelve o establece el formato del objeto especificado oFind:Set( "MatchCase", .f. ) //True si la búsqueda distingue mayúsculas de minúsculas. oFind:Set( "MatchWholeWord", .f. ) //True si la operación de búsqueda sólo busca palabras completas y no texto que forme parte de una palabra. oFind:Set( "MatchWildcards", .t. ) //True si el texto va a buscarse contiene comodines de búsqueda oFind:Set( "MatchSoundsLike", .f. ) //Recibe el valor True si la operación de búsqueda encuentra las palabras que tienen un sonido parecido al del texto buscado oFind:Set( "MatchAllWordForms", .f. ) //Recibe el valor True si la operación de búsqueda encuentra todas las formas del texto que se debe buscar oFind:Invoke( "Execute") DO WHILE oFind:Get( "Found" ) oTexto:Set( "Text",cText ) oFind:Invoke( "Execute") Enddo nEnd := oTexto:Get("End") Release oTexto , oFind RETURN( nEnd ) ********************************* STATIC 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 RETU cChar ******************************** Function sBreak(o,c,x,lShowAlert,lQuit) DEFAULT c:="ERROR",x:="",lQuit:=.f. IF lShowAlert=NIL MsgStop(If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation),c) ENDIF IF lQuit MemoWrit("Error.log",If(Empty(x),"",x+CRLF+CRLF)+AllTrim(o:Description)+": "+AllTrim(o:Operation)) QUIT ENDIF BREAK RETU NIL ******************************** Function V(x) LOCAL y:=ValType(x),cRetu:="" DO CASE CASE y=="C" ; RETU x CASE y=="M" ; RETU x CASE y=="N" ; RETU If(Empty(x),"",LTrim(Str(x))) CASE y=="D" ; RETU If(Empty(x),"",DtoC(x)) CASE y=="A" ; RETU (AEval(x,{|a|cRetu+=RTrim(V(a))+","}),SubStr(cRetu,1,Len(cRetu)-1)) CASE y=="L" ; RETU If(x,".T.",".F.") CASE y=="U" ; RETU "_NIL_!" CASE y=="B" ; RETU V({Eval(x)}) CASE y=="O" ; RETU "_OBJECT_!" OTHER ; RETU "?" ENDCASE RETU x Pompeo Guaratinguetá - SP (12) 9777-9386 E-Mail: mkyx@ig.com.br MSN: mkyx@ig.com.br Skype: pardes.mky www.adentech.com.br www.rmahost.com xH 1.1.0 Hb 8.02 - BCC 55 Quote Link to comment Share on other sites More sharing options...
Eric.Developer Posted March 4, 2010 Report Share Posted March 4, 2010 Esse Alert foi exibido ? de qualquer forma, há pelo menos um erro, o uso do objeto oWord deve estar antes do CATCH oError: CATCH oError // E avisamos ao usuario o motivo do erro! Alert( oError:description ) Correto: STATIC FUNCTION GeraTword(aCampos) // CAMIFO) local x, cARQDOC := "TESTE.doc" oWord := TWord():New() // inicia o objeto OLE Word cDEST:="RET_RRR.DOC" COPYFILE(cARQDOC ,cDEST,.F.) if oWord:IsVisible() **oWord:Hide() endif TRY oWord:OpenDoc( cDEST ) // abre o documento modelo FOR x=1 to len( aCampos ) oWord:Replace( aCampos[x,1], aCampos[x,2] ) NEXT oWord:Save(CDEST) // CAMIFO) oWord:PREVIEW() //oWord:visualiza() //oWord:Printdoc(.F.) oWord:End() CATCH oError // E avisamos ao usuario o motivo do erro! Alert( oError:description ) End RETURN(.T.) Virtualmente, Eric Developer.Systems São Paulo - SP - Brasil Freelance/Consultorias www.magaldi.eti.br Quote Link to comment Share on other sites More sharing options...
Eric.Developer Posted March 4, 2010 Report Share Posted March 4, 2010 a propósito, quando qualquer tipo de erro acontece linhas depois que teve sucesso, iniciou, abriu a comunicação com OLE (Word, etc), o método :END() (ou equivalente), ainda precisa ser usado para fechar essa comunicação, porém de forma bem estratégica. Virtualmente, Eric Developer.Systems São Paulo - SP - Brasil Freelance/Consultorias www.magaldi.eti.br Quote Link to comment Share on other sites More sharing options...
mkyx Posted March 4, 2010 Author Report Share Posted March 4, 2010 Agora tirei os TRYs da vida, daà ficou mais simples, o erro agora no method opendoc, na linha: 434, conf listagem abaixo: ::oMailMerge := ::oActiveDoc:Get( "MailMerge") #include "fivewin.ch" // Gera array com o texto para tWord function main() PRIVATE aCampos := {} PU:=100000 AADD(aCampos,{"[RAZAOSOCIAL]","Kosmos Comercial Ltda Rua Dr. Morais Filho 11 - Centro"}) AADD(aCampos,{"[CNPJ_CEI]","45.456.556/0001-20"}) AADD(aCampos,{"[TOMADOR]",SPACE(10)}) GeraTword(aCampos) RETURN .T. ***************************************** STATIC FUNCTION GeraTword(aCampos) // CAMIFO) local x, cARQDOC := "TESTE.doc" oWord := TWord():New() // inicia o objeto OLE Word cDEST:="RET_RRR.DOC" COPYFILE(cARQDOC ,cDEST,.F.) oWord:OpenDoc( cDEST ) // abre o documento modelo FOR x=1 to len( aCampos ) oWord:Replace( aCampos[x,1], aCampos[x,2] ) NEXT oWord:Save(CDEST) // CAMIFO) oWord:PREVIEW() oWord:End() RETURN(.T.) ************************************************************ ** listagem do erro Application =========== Path and name: D:\xh\bin\word.exe (32 bits) Size: 1,538,560 bytes Time from start: 0 hours 0 mins 0 secs Error occurred at: 03/04/10, 04:27:37 Error description: Error BASE/1004 Class: 'NIL' has no exported method: GET Args: [ 1] = U [ 2] = C MailMerge Stack Calls =========== Called from: tget.prg => GET(0) Called from: TWORDHB.PRG => TWORD:OPENDOC(434) Called from: WORD.PRG => GERATWORD(26) Called from: WORD.PRG => MAIN(10) System ====== CPU type: 1666 Mhz Hardware memory: 1015 megs Free System resources: 90 % GDI resources: 90 % User resources: 90 % Compiler version: xHarbour build 1.1.0 Intl. (SimpLex) Windows version: 5.1, Build 2600 Service Pack 3 Windows total applications running: 0 Pompeo Guaratinguetá - SP (12) 9777-9386 E-Mail: mkyx@ig.com.br MSN: mkyx@ig.com.br Skype: pardes.mky www.adentech.com.br www.rmahost.com xH 1.1.0 Hb 8.02 - BCC 55 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.