Создание документа Word из Delphi, сохранение в формате Doc и PDF

Question

Мне нужно создать документ Word из Delphi с использованием определенного шаблона, сохранить документ как документ Word с заданным именем, а затем сохранить тот же документ с тем же именем, но в виде файла PDF. (В Word 2007 это можно сделать с помощью плагина SaveAsPdf .... В Word 2010 это встроенная функция)

Как это можно сделать с помощью Delphi XE?

Answer 1

Сначала импортируйте библиотеку типов «Объекты Microsoft Word 12» (MS Word 2007) в ваш проект, используя Компоненты | Пункт меню «Импорт компонентов». Затем вы можете использовать этот пример кода для загрузки файла MS Word и сохранить его в формате PDF с помощью внутреннего конвертера PDF. Если вы используете Microsoft Word 2010, загрузите его библиотеку типов вместо Word 2007.

unit fMain;

interface

uses
  Windows, SysUtils, Variants, Classes, Controls, Forms, Dialogs, StdCtrls,
  Word_TLB;

type
  TfrmMain = class(TForm)
    btnLoad: TButton;
    btnSaveAs: TButton;
    FileOpenDialog1: TFileOpenDialog;
    FileSaveDialog1: TFileSaveDialog;
    procedure btnLoadClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSaveAsClick(Sender: TObject);
  private
    FWordApp : WordApplication;
    FWordDoc : WordDocument;
    procedure InitializeApp;
    procedure FinalizeApp;
    function LoadFile(const AFileName: string): WordDocument;
    procedure SaveAsPdf(ADocument: WordDocument; const AFileName: string);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses ComObj;

{$R *.dfm}

procedure TfrmMain.btnLoadClick(Sender: TObject);
begin
  if FileOpenDialog1.Execute then
    FWordDoc := LoadFile(FileOpenDialog1.FileName);
end;

procedure TfrmMain.btnSaveAsClick(Sender: TObject);
begin
  if FileSaveDialog1.Execute then
  begin
    if Assigned(FWordDoc) then
      SaveAsPdf(FWordDoc, FileSaveDialog1.FileName);
  end;
end;

procedure TfrmMain.FinalizeApp;
var
  SaveChanges: OleVariant;
begin
  if Assigned(FWordApp) then
  begin
    SaveChanges := False;
    FWordApp.Quit(SaveChanges, EmptyParam, EmptyParam);
    FWordApp := nil;
  end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FinalizeApp;
end;

procedure TfrmMain.InitializeApp;
begin
  FWordApp := createOleObject('Word.Application') as WordApplication;
  if Assigned(FWordApp) then
  begin
    FWordApp.Visible := False;
  end
  else
    raise Exception.Create('Cannot initialize Word application');
end;

function TfrmMain.LoadFile(const AFileName: string): WordDocument;
var
  FileName: OleVariant;
  Doc : WordDocument;
begin
  if not Assigned(FWordApp) then
    InitializeApp;

  FileName := AFileName;
  Doc := FWordApp.Documents.Open(FileName, EmptyParam, EmptyParam, EmptyParam,
                                 EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                 EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                                 EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  Result := Doc;
end;

procedure TfrmMain.SaveAsPdf(ADocument: WordDocument; const AFileName: string);
var
  FileName,
  FileFormat : OleVariant;
begin
  if Assigned(ADocument) then
  begin
    FileName := AFileName;
    FileFormat := wdFormatPDF;
    ADocument.SaveAs(FileName, FileFormat, EmptyParam, EmptyParam, EmptyParam,
                     EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                     EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                     EmptyParam);
  end;
end;

end.

Я просто написал код и запустил его один раз, он работает, но я не проверил его полностью, поэтому могут быть некоторые глюки.

Answer 2

Этот код помогает мне, но, как вы видите, мне нужно сразу сохранить документ и открыть его снова с помощью ShellExecute. Если нет, я получаю сообщение об ошибке «Сервер RPC недоступен», о котором я упоминал ранее.

procedure TfrmJobsearchAdverts.FileCreate;
var
  TempName: OleVariant;
  FileDoc: OleVariant;
  FileFormat: OleVariant;
  Doc : WordDocument;
  WordTemplate: string;
  WordFile: string;
  BookName: OleVariant;
begin
  SaveRecord;
  WordFile := Advert.CreateDocname(qryAdverts.FieldByName('fldadvert_date').AsDateTime);
  WordTemplate := JobsearchTemplate(Self);
  if (WordFile <> '') and (WordTemplate <> '') then
    begin
      Advert.SaveDocname(qryAdverts.FieldByName('fldadvert_guid').AsString, WordFile);
      if not Assigned(fWordApp) then
        InitializeWord;
      TempName := WordTemplate;
      FileDoc := WordFile;
      Doc := FWordApp.Documents.Add(TempName, EmptyParam, EmptyParam, EmptyParam);
      BookName := 'fldCompany';
      if Doc.Bookmarks.Exists(BookName) then
        Doc.Bookmarks.Item(BookName).Range.Text := Company.Name;
      BookName := 'fldAddress1';
      if Doc.Bookmarks.Exists(BookName) then
        Doc.Bookmarks.Item(BookName).Range.Text := Company.Address1;
      BookName := 'fldAddress2';
      if Doc.Bookmarks.Exists(BookName) then
        Doc.Bookmarks.Item(BookName).Range.Text := Company.Address2;
      BookName := 'fldZip';
      if Doc.Bookmarks.Exists(BookName) then
        Doc.Bookmarks.Item(BookName).Range.Text := Company.Zip;
      BookName := 'fldCity';
      if Doc.Bookmarks.Exists(BookName) then
        Doc.Bookmarks.Item(BookName).Range.Text := Company.City;
      FileFormat := wdFormatDocument;
      Doc.SaveAs(FileDoc, EmptyParam, EmptyParam, EmptyParam,
                 EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                 EmptyParam, EmptyParam, EmptyParam, EmptyParam,
                 EmptyParam, EmptyParam, EmptyParam, EmptyParam);
      FinalizeWord;
      Files.ExecuteAndWait(WordFile);
    end;
end;