Muy buenas tardes.
Hace un tiempo atrás, logre poder actualizar una plantilla Word, con datos variables y funciono muy bien.
He buscado en el foro algo que se ajuste a lo que necesito, pero no doy.
Pues ahora a esta misma plantilla, necesito incorporar 2 cosas:
- Un codigo QR, generado por dos datos variables (nFicha + cRut).
- Firma del profesional medico que se encuentra en BMP.
Actualmente lo que hace esta función, es abrir el archivo plantilla Word, reemplazar los campos variables que vienen de una dbf, grabar archivo en disco y al finalizar, imprimir una copia de este documento.
Hoy requiero, después de poder incorporar el QR y Firma, dar la opción de Imprimir directo o Exportar a PDF.
Necesito resolverlo con urgencia.
Saludos
Antonio
Código Funcionando Actualmente de la Función:
- Code: Select all Expand view
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
