unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Comobj, ActiveX, StdCtrls, WordXP, OleServer;

type
  TForm1 = class(TForm)
    Button1: TButton;

    Edit1: TEdit;

    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);

  private
    { Private declarations }
  public
     Procedure CreateWord;
     procedure AddDoc(i:integer);
    procedure SaveDocAs;
  end;

var
  Form1: TForm1; w: variant;  r:variant;
  NA,NV:integer;
implementation

{$R *.dfm}
Procedure TForm1.CreateWord;
begin

  try
    W:=CreateOleObject('Word.Application');
    W.visible:= false;
  except
   showmessage('Ошибка создания Word-объекта');
  end;
End;
procedure TFORM1.AddDoc(i:integer);
begin

  try
     W.Documents.Add(GetCurrentDir+'\'+inttostr(i)+'.doc');
     W.visible:= false;
     r:=w.ActiveDocument.Range;
  except
   showmessage('Ошибка открытия документа Word');
  end;
End;
procedure TForm1.SaveDocAs;
begin

  try
    W.ActiveDocument.SaveAs(GetCurrentDir+'\TEMP.doc');
  except
       showmessage('Ошибка сохранения документа Word');
  end;
End;


procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer; s:string; ind:array[1..50,1..1000] of integer;
begin
try
CreateWord; w.Documents.Add;  SaveDocAs;

for i:=1 to NA do
begin
 AddDoc(i);
 w.Documents.Item('temp.doc').Activate;
 w.Documents.Item('temp.doc').Range.InsertAfter(r.text);

// w.Docurments.Item(i).Close;
end;
 SaveDocAs;
 for i:=1 to NA do
 for j:=1 to NV+1 do
 begin
 ind[j,i]:=pos('*',w.ActiveDocument.Range.Text);
 w.ActiveDocument.Range(ind[j,i]-1,ind[j,i]).cut;
 end;
 SaveDocAs;
 for j:=1 to NV do
 begin
  w.ActiveDocument.Range.InsertAfter('                                          Вопрос '+inttostr(j)+#13);
 for i:=1 to NA do
  begin
   r:=w.ActiveDocument.Range(ind[j,i],ind[j+1,i]);
   w.ActiveDocument.Range.InsertAfter(r.text);
  end;
 end;
 w.ActiveDocument.Range(0,ind[NV+1,NA]).cut;
 W.ActiveDocument.SaveAs(GetCurrentDir+'\OBRABOTKA.doc');
 showmessage('Результаты находятся в файле OBRABOTKA.doc');
 except
 showmessage('Проверьте соответствие Ваших данных требованиям программы');
 w.documents.Close;
 w.Application.quit;
 w:=Unassigned;
 end;
 w.documents.Close;
 w.Application.quit;
 w:=Unassigned;
 end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
 NA:=strtoint(Edit1.Text);
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
NV:=strtoint(Edit2.Text);
end;
end.