Hola Francisco
Como estas, muchas gracias por toda tu preocupacion, ayuda y tiempo invertido, tambien para Carlos que estuvo presente.
Hasta aquí con tu ultima modificacion, funcionando PERFECTO , controla archivos abiertos y no se ha colgado.
Lo que dices en que se abren 2 archivos es verdad, lo que si revise en el administrador no hay mas archivos abiertos que los que deben estar.
Ruego que sea definitivo, ya que debo instalar sobre configuracion que posee el cliente y no a obligarlo a realizar cambios.
Estoy muy contento por esta funcionando, lo que si quiero destacar, se que somos muchos en este foro, pero lo que estan presente en ocaciones asi, son siempre los mismos y muy pocos. Pero debe haber un algun motivo.
Mil gracias Francisco por todo tu esfuerzo y preocupacion,
Estamos en contacto.
Muchos Saludos
Antonio
Dejo el Codigo Completo para quien lo quiera usar, funcionando como dije PERFECTO:
Code: Select all
Function Genera_Examen_Altura(nFicha,cTAte,dfec,cNom,cRut,nEdad,cNaci,cOtos,cVis,cPes,cAlt,cPart,cPul,cFres,cEle,cGli,cEva,cHem,cUre,cOri)
Local oWord, oSel, oDoc,cOrigen,cDestino,cFile,cSave, Nom1,rut1,naci1,cFilep,cSavep,cDestinop
local oActiveDoc,aArrReplace, n
IF MsgYesNo( "Desea Generar ARCHIVOS EXAMENES ALTURA / PRE-OCU ?","Ingrese Opción")
Do Case
Case Tip_Ate1=="A"
If (Empty(cNom).or.Empty(cRut).or.Empty(nEdad).or.Empty(cNaci).or.Empty(cOtos).or.Empty(cVis).or.Empty(cPes) .or. Empty(cAlt).or. Empty(cPart) .or. Empty(cPul).or.Empty(cFres).or.Empty(cEva).or.Empty(cEle).or.Empty(cGli))
Tone(3000)
MsgInfo("Revise, Faltan Relacionados a Examen de Altura")
Return .F.
Endif
MsgInfo( "Atención: " + CRLF +;
"En estos momentos Ud.Generará e Imprimirá" + CRLF +;
"Un Informe de Examen de Altura, por lo que" + CRLF +;
"Esperar hasta que se muestre un aviso con" + CRLF +;
"El Nombre del Informe Generado, en ese momento" + CRLF +;
"El Proceso habra terminado.")
Case Tip_Ate1=="P"
If (Empty(cNom).or.Empty(cRut).or.Empty(nEdad).or.Empty(cNaci).or.Empty(cOtos).or.Empty(cVis).or.Empty(cPes);
.or. Empty(cAlt).or. Empty(cPart) .or. Empty(cPul).or.Empty(cFres).or.Empty(cEva).or.Empty(cEle).or.Empty(cGli).or. Empty(cHem).or.Empty(cUre).or.Empty(cOri))
Tone(3000)
MsgInfo("Revise, Faltan Datos Relacionados a Examen de Altura o Pre-Ocupacional")
Return .F.
Endif
MsgInfo( "Atención: " + CRLF +;
"En estos momentos Ud.Generará e Imprimirá" + CRLF +;
"Un Informe de Examen de Altura y un Pre-Ocupacional" + CRLF +;
"Esperar hasta que se muestre 2 avisos con El Nombre" + CRLF +;
"de los Informes Generados, en ese momento El Proceso" + CRLF +;
"habra terminado.")
EndCase
cNom:= AnsiToOem(cNom)
nEva:= aScan(aEvaMed, { | array | array[1] == cEva} )
cEva=aEvaMed[nEva ][2] // <--- Obtener Nombre del dato del arreglo
cEle:= AnsiToOem(cEle)
cGli:= AnsiToOem(cGli)
cOrigen := hb_CurDrive()+":\"+curdir()+"\Examenes\Doc_Bases\"
cDestinoa := hb_CurDrive()+":\"+curdir()+"\Examenes\Altura\"
cDestinop := hb_CurDrive()+":\"+curdir()+"\Examenes\Pre-Ocu\"
cFile := "AlturaBase.docx"
cSave := "Altura-"+alltrim(Str(nFicha,10))+"-"+cNom+".doc"
cFilep := "PreocuBase.docx"
cSavep := "Pre-"+alltrim(Str(nFicha,10))+"-"+cNom+".doc"
If lDocAbierto(cOrigen + cFile) //variable que contiene path , nombre, y ext. del fichero modelo o plantilla
MsgStop("Documento " + cFile + " está abierto.","Alto")
Return .f.
endif
*/
TRY
oWord := win_oleCreateObject( "Word.Application")
CATCH
MsgInfo("Word no está instalado en esta PC. No se puede continuar")
Return NIL
END
TRY
oDoc := oWord:Documents:Open(cOrigen + cFile)
CATCH
MsgInfo("No se puede abrir el archivo plantilla " + cOrigen + cFile)
oWord:Quit()
Return NIL
END
oDoc:Select()
oSel = oWord:Selection
aArrReplace := { { "[nombrepaciente]", AllTrim(cNom) } ,;
{ "[rut]" , AllTrim(cRut) } ,;
{ "[edad]" , AllTrim(Str(nEdad,3)) } ,;
{ "[naciona]" , AllTrim(cNaci) },;
{ "[otos]" , AllTrim(cOtos) },;
{ "[visi]" , AllTrim(cVis) },;
{ "[pes]" , AllTrim(cPes) },;
{ "[alt]" , AllTrim(cAlt) },;
{ "[par]" , AllTrim(cPart) },;
{ "[pul]" , AllTrim(cPul) },;
{ "[fr]" , AllTrim(cFres) },;
{ "[eva]" , AllTrim(cEva) },;
{ "[ekg]" , AllTrim(cEle) },;
{ "[gli]" , AllTrim(cGli) },;
{ "[fate]" , Dtoc(dfec) } }
For n:=1 to Len(aArrReplace)
Reemplaza_Text_F2( oSel, aArrReplace[n][1], aArrReplace[n][2] )
Next n
oWord:ActiveDocument:SaveAs(cDestinoa + cSave)
// oWord:ActiveDocument:PrintOut() // Habilitar Imprime Dcoumento
oWord:ActiveDocument:Close()
SysRefresh()
MsgInfo(" Examen de Altura Generado "+cSave)
** Si Existe Pre-Ocupacional
If cTAte = "P"
If lDocAbierto(cOrigen + cFilep ) //variable que contiene path , nombre, y ext. del fichero modelo o plantilla
MsgStop("Documento " + cFilep + " está abierto.","Alto")
Return .f.
endif
TRY
oWord := win_oleCreateObject( "Word.Application")
CATCH
MsgInfo("Word no está instalado en esta PC. No se puede continuar")
Return NIL
END
TRY
oDoc := oWord:Documents:Open(cOrigen + cFilep )
CATCH
MsgInfo("No se puede abrir el archivo plantilla " + cOrigen + cFilep)
oWord:Quit()
Return NIL
END
* oWord:Visible:=.T. // Para Mostrar
oDoc:Select()
oSel = oWord:Selection
// Crear Matriz de reemplazos
aArrReplace := { { "[nombrepaciente]", AllTrim(cNom) } ,;
{ "[rut]" , AllTrim(cRut) } ,;
{ "[edad]" , AllTrim(Str(nEdad,3)) } ,;
{ "[naciona]" , AllTrim(cNaci) },;
{ "[pes]" , AllTrim(cPes) },;
{ "[alt]" , AllTrim(cAlt) },;
{ "[par]" , AllTrim(cPart) },;
{ "[ekg]" , AllTrim(cEle) },;
{ "[eva]" , AllTrim(cEva) },;
{ "[gli]" , AllTrim(cGli) },;
{ "[hem]" , AllTrim(cHem) },;
{ "[ure]" , AllTrim(cUre) },;
{ "[ori]" , AllTrim(cOri) },;
{ "[fate]" , Dtoc(dfec) } }
For n:=1 to Len(aArrReplace)
Reemplaza_Text_F2( oSel, aArrReplace[n][1], aArrReplace[n][2] )
Next n
oWord:ActiveDocument:SaveAs(cDestinop + cSavep)
// oWord:ActiveDocument:PrintOut() // Habilitar Para Imprimir
oWord:ActiveDocument:Close()
SysRefresh()
MsgInfo(" Examen de Pre-Ocupacional Generado "+cSavep)
Endif
** Fin Pre-Ocupa
Endif
Return nil
//---------------------------------------------------//
Static Function Reemplaza_Text_F2( oSel, cSrc, cRpl)
Local wdCollapseEnd:=0
LOCAL oRng := oSel:Document:Content
IF AT( cSrc, oRng:Text ) = 0
RETURN .F.
ENDIF
WHILE oRng:Find:Execute( cSrc )
oRng:Text = cRpl
oRng:Collapse( wdCollapseEnd )
ENDDO
RETURN .T.
// Para Consultar si Archivo Plantilla esta Abierto
Function lDocAbierto(cDocName)
Local FO_EXCLUSIVE := 16
local lOpen:=.f., nHand
If ( nHand := FOPEN(cDocName, FO_EXCLUSIVE ) ) = -1
lOpen := .t.
Else
FCLOSE( nHand )
Endif
Return lOpen
