Виртуальная библиотека Delphi - [18]

    Sum        : double;  {итоговая сумма, кстати,совет: не пользуйтесь типом real!}
    Tv, Ss     : PChar;
begin
S:=GetCurrentDir+'\Накладная.doc'; { имя открываемого документа }
DDE1.OpenLink; { устанавливаем связь }
Tv:=StrAlloc(20000); Ss:=StrAlloc(300); { выделяем память }
  { даем команду открыть документ и установить курсор в начало документа }
StrPCopy(Tv, '[FileOpen "'+S+'"][StartOfDocument]');
S:=NNakl.Text; { номер накладной }
  { записываем в позицию Num номер накладной }
StrCat(Tv, StrPCopy(SS, '[EditBookmark .Name = "Num", .Goto][Insert "'+S+'"]'+
'[EditBookmark .Name = "Table", .Goto]'); { и переходим к заполнению таблицы }
  { передаем данные в Word }
if not DDE1.ExecuteMacro(Tv, false) then
   begin { сообщаем об ошибке и выход }
    MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0);
    StrDispose(Tv); StrDispose(Ss);
    exit;
   end;
  { Заполняем таблицу }
Sum:=0; Nn:=0;
for i:=0 to TCount do
begin
  inc(Nn);
  { предполагаем, что данные находятся в массиве T }
  StrPCopy(Tv, '[Insert "'+IntToStr(Nn)+'"][NextCell][Insert "'+T[i].Company+'"]'+
   '[NextCell][Insert "'+T.TName+'"][NextCell][Insert "'+T.Cod+'"][NextCell]'+
   '[Insert "'+IntToStr(T.Count)+'"][NextCell]'+
   '[Insert "'+FloatToStr(T.Cena)+'"][NextCell]'+
   '[Insert "'+FloatToStr(T.Count*T.Cena)*+'"][NextCell]'));
  inc(Nn);
  Sum:=Sum+(T.Count*T.Cena); { итоговая сумма }
  if not DDE1.ExecuteMacro(Tv, false)
   then begin
    MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0);
    exit;
   end;
end;
{ Записываем итоговую сумму }
StrPCopy(Tv,
  '[NextCell][Insert "Итого"][NextCell][NextCell][NextCell]'+
  '[Insert "'+FloatToStr(Sum)+'"]'));
if not DDE1.ExecuteMacro(Tv, false)
  then MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0)
  else MessageDlg('Акт удачно создан. Перейдите в Microsoft Word.',
        mtInformation, [mbOk], 0);
StrDispose(Tv); StrDispose(Ss);
end;

 Для Delphi 2 и выше

=== Cut Пример by Sergey Arkhipov 2:5054/88.10 ===

Пример проверен только на русском Word 7.0! Может, поможет...

unit InWord;
interface
uses
  ... ComCtrls; // Delphi3
  ... OLEAuto;  // Delphi2
[skip]
procedure TPrintForm.MPrintClick(Sender: TObject);
var W: Variant;
    S: String;
begin
  S:=IntToStr(Num);
  try // А вдруг где ошибка :)
    W:=CreateOleObject('Word.Basic');
    // Создаем документ по шаблону MyWordDot
    // с указанием пути если он не в папке шаблонов Word
    W.FileNew(Template:='C:\MyPath\DB\MyWordDot',NewTemplate:=0);
    // Отключение фоновой печати (на LJ5L без этого был пустой лист)
    W.ToolsOptionsPrint(Background:=0);
   // Переходим к закладке Word'a 'Num'
    W.EditGoto('Num'); W.Insert(S);
   //Сохранение
    W.FileSaveAs('C:\MayPath\Reports\MyReport')
    W.FilePrint(NumCopies:='2'); // Печать 2-х копий
  finally
    W.ToolsOptionsPrint(Background:=1);
    W:=UnAssigned;
  end;
end;
{.....}

 === Cut Конец примера ===

Спасибо Сергею :) И еще, как определить установлен ли на компьютере Word, запустить его и загрузить в него текст из программы?

Пример:

var
MsWord: Variant;
...
try
// Если Word уже запущен
MsWord := GetActiveOleObject('Word.Application');
// Взять ссылку на запущенный OLE объект
except
  try
  // Word не запущен, запустить
  MsWord := CreateOleObject('Word.Application');
  // Создать ссылку на зарегистрированный OLE объект
  MsWord.Visible := True;
   except
    ShowMessage('Не могу запустить Microsoft Word');
    Exit;
   end;
  end;
end;
...
MSWord.Documents.Add; // Создать новый документ
MsWord.Selection.Font.Bold := True; // Установить жирный шрифт
MsWord.Selection.Font.Size := 12; // установить 12 кегль
MsWord.Selection.TypeText('Текст');

По командам OLE Automation сервера см. help по Microsoft Word Visual Basic.

Ну вот и все.

Перетаскивание файла

{ На эту форму можно бросить файл (например из проводника)
и он будет открыт }
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs,StdCtrls,
  ShellAPI {обязательно!};
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    FileNameLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
   {Это и есть самая главная процедура}
    procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles;
end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMDropFiles(var Msg: TMessage);
var
   Filename: array[0 .. 256] of Char;
   Count   : integer;
begin
  { Получаем количество файлов (просто пример) }
   nCount := DragQueryFile( msg.WParam, $FFFFFFFF,
     acFileName, cnMaxFileNameLen);
{ Получаем имя первого файла }
  DragQueryFile( THandle(Msg.WParam),
     0, { это номер файла }
     Filename,SizeOf(Filename) ) ;
  { Открываем его }
  with FileNameLabel do begin
   Caption := LowerCase(StrPas(FileName));
   Memo1.Lines.LoadfromFile(Caption);
  end;
{ Отдаем сообщение о завершении процесса }
  DragFinish(THandle(Msg.WParam));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{ Говорим Windows, что на нас можно бросать файлы }
DragAcceptFiles(Handle, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
{ Закрываем за собой дверь золотым ключиком}