nelem
05-11-2007, 13:37:38
Hola estoy intentando pasar un documento word a pdf.
Muchas gracias
Chris
05-11-2007, 15:41:12
Yo lo hago con open office, desde delphi, mediante COM (a Open Office)
marcoszorrilla
05-11-2007, 15:55:14
Tambien puedes instalar un controlador de impresora que hay por ahí que en vez de imprimir lo que hace es pasarlo a PDF.
Un Saludo.
Neftali [Germán.Estévez]
05-11-2007, 15:58:53
Otra opción es usar algunas de las páginas en Internet que te lo convierten OnLine (PDFOnline, por ejemplo).
nelem
05-11-2007, 16:21:25
Hola D&W me podrias escribir algo del códigop o explicarme un poco mas es que no se a lo que te refieres.
Chris
05-11-2007, 16:37:17
Claro, ahí va:
Primero crea un unidad aparte....
unit ooo_Save2PDF;
interface
uses variants, ComObj, windows, SysUtils, StrUtils, ActiveX;
type
TOOOWriterEx = class(TObject)
private
fOpenOffice : Variant;
fDocument : Variant;
fConnected : boolean;
fDocumentOpened : boolean;
FOwnCreatedOLE : Boolean;
fDesktop : Variant;
function MakePropertyValue(PropName:string; PropValue:variant):variant;
public
Constructor Create;
destructor Destroy; override;
Property OLECreated : Boolean read FOwnCreatedOLE;
function Connect : boolean;
procedure Disconnect;
Procedure CloseActiveDoc;
function OpenDocument(Filename:string; invisible : Boolean = true):boolean;
Function SaveToPDF(pFileName: string):String;
Function SaveToHTML(FileName:String):String;
procedure SaveDocument(FileName: string);
procedure CloseDocument;
Function ConvertToPDF(DocumentFile, PDFFile : String; invisible : Boolean = true):String;
Function ConvertToHTML(DocumentFile, HTMLFile : String; invisible : Boolean = true):String;
end;
implementation
Uses Dialogs;
{ TOOOWriterEX }
procedure TOOoWriterEx.CloseDocument;
begin
if fDocumentOpened then
begin
fDocument.Close(false);
fDocumentOpened := false;
fDocument := Unassigned;
fDesktop.Terminate;
fDesktop := UnAssigned;
end;
end;
Procedure TOOoWriterEx.CloseActiveDoc;
begin
if fDocumentOpened then
fDocument.Close(false);
end;
function TOOoWriterEx.Connect: boolean;
begin
if VarIsEmpty(fOpenOffice) then
Begin
{ Try
fOpenOffice := GetActiveOleObject('com.sun.star.ServiceManager');
FOwnCreatedOLE := False;
Except }
Try
fOpenOffice := CreateOleObject('com.sun.star.ServiceManager');
FOwnCreatedOLE := True;
Except
Begin
ShowMessage('No se ha podido iniciar el objeto OLE para la conección a OpenOffice.'+#13+
'Verifique que el sitema OpenOffice esté instalado adecuadamente en su equipo.');
Exit;
end;
end; // fin de try
// end;
end;
fConnected := not (VarIsEmpty(fOpenOffice) or VarIsNull(fOpenOffice));
Result := fConnected;
end;
constructor TOOoWriterEx.Create;
begin
inherited;
CoInitialize(nil);
end;
destructor TOOoWriterEx.Destroy;
begin
CoUninitialize;
inherited;
end;
procedure TOOoWriterEx.Disconnect;
begin
if fDocumentOpened then
CloseDocument;
fConnected := false;
fOpenOffice := Unassigned;
end;
function TOOoWriterEx.MakePropertyValue(PropName: string;
PropValue: variant): variant;
var
Struct: variant;
begin
Struct := fOpenOffice.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
Struct.Name := PropName;
Struct.Value := PropValue;
Result := Struct;
end;
function TOOoWriterEx.OpenDocument(Filename: string; invisible : Boolean = true): boolean;
var
wProperties : Variant;
begin
if not fConnected then
abort;
fDesktop := fOpenOffice.createInstance('com.sun.star.frame.Desktop');
wProperties := VarArrayCreate([0, 0], varVariant);
wProperties[0] := MakePropertyValue('Hidden', invisible);
fDocument := fDesktop.loadComponentFromURL( 'file:///'+ AnsiReplaceText(ExpandFileName(FileName),'\','/')
, ' _blank', 8, wProperties);
fDocumentOpened := not (VarIsEmpty(fDocument) or VarIsNull(fDocument));
result := fDocumentOpened;
end;
Function TOOoWriterEx.SaveToPDF(pFileName: string):String;
var
wProperties: variant;
begin
Result := '';
if not (fConnected and fDocumentOpened) then
abort;
wProperties := VarArrayCreate([0, 0], varVariant);
wProperties[0] := MakePropertyValue('FilterName', 'writer_pdf_Export');
try
fDocument.StoreToURL('file:///'+ AnsiReplaceText(ExpandFileName(pFileName),'\','/'), wProperties);
except on E: EOleException do
Result := E.Message;
end;
end;
Function TOOoWriterEx.SaveToHTML(FileName:String):String;
var
wProperties: variant;
begin
if not (fConnected and fDocumentOpened) then
abort;
wProperties := VarArrayCreate([0, 0], varVariant);
wProperties[0] := MakePropertyValue('FilterName', 'HTML (StarWriter)');
try
fDocument.StoreToURL('file:///'+ AnsiReplaceText(ExpandFileName(FileName),'\','/'), wProperties);
except on E: EOleException do
Result := E.Message;
end;
end;
procedure TOOoWriterEx.SaveDocument(FileName: string);
var
wProperties: variant;
begin
if not (fConnected and fDocumentOpened) then
abort;
wProperties := VarArrayCreate([0, 0], varVariant);
wProperties[0] := MakePropertyValue('FilterName', '');
fDocument.StoreToURL('file:///'+ AnsiReplaceText(FileName,'\','/'), wProperties);
end;
Function TOOoWriterEx.ConvertToPDF(DocumentFile, PDFFile : String; invisible : Boolean = true):String;
Begin
Result := '';
If Not fConnected Then Connect;
If OpenDocument(DocumentFile) Then
Result := SaveToPDF(PDFFile);
CloseActiveDoc;
end;
Function TOOoWriterEx.ConvertToHTML(DocumentFile, HTMLFile : String; invisible : Boolean = true):String;
Begin
Result := '';
If Not fConnected Then Connect;
If OpenDocument(DocumentFile) Then
Result := SaveToHTML(HTMLFile);
CloseActiveDoc;
end;
end.
Para utilizarlo:
Procedure Convertir_aPDF(wordFile, PDFFile:TFileName);
var
FOOOInterface : TOOoWriterEx;
Begin
Try
FOOOInterface := TOOoWriterEx.Create;
FOOOInterface.ConvertToPDF(wordFile,PDFFile);
If FOOOInterface.OLECreated Then
Begin
FOOOInterface.CloseDocument;
FOOOInterface.Disconnect;
end;
Finally
FOOOInterface.Free;
end;
end;
Ese es un ejemplo, no estoy seguro de que servirá porque es una extracción rápida del código que utilizo en mis programas, pero pruebalo.
Saludos.
nelem
05-11-2007, 16:47:17
Muchisimas gracias ya te contare.
nelem
06-11-2007, 16:54:48
Ya lo hemos estado probando y funciona todo OK. Muchas gracias por tu ayuda
vBulletin v3.6.8, Derechos ©2000-2024, Jelsoft Enterprises Ltd.