PDA

Ver la Versión Completa : de word a pdf


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