uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ComCtrls, WordXP, OleServer, FileCtrl, ComObj;
...
procedure TForm8.Button1Click(Sender: TObject);
const
// массивные маркеры
marker: array[1..19] of string[25] =
('%sotrudnik%', // Маркер выбора сотрудника
'%date_in%', // Маркер даты начала командировки
'%date_out%', // Маркер даты окончания командировки
'%archive_nomer%', // Маркер номера служебной записки о сдаче в архив
'%station%', // Маркер трансгаза
'%msku%', // Маркер шифра системы
'%rez_pnr%', // Маркер блока "Результат ПНР"
'%akty%', // Маркер блока "Акты по результатам ПНР"
'%ostalos%', // Маркер блока "Оставшиеся работы"
'%zamechaniya_pr%', // Маркер блока "Замечания к качеству производства"
'%zamechaniya_pr_dok%', // Маркер блока "Основания по замечаниям к качеству производства"
'%oborudovanie%', // Маркер блока "Оборудование, необходимое для завершения ПНР"
'%oborudovanie_doc%', // Маркер блока "Основания для выписывания оборудования"
'%zamechaniya_doc%', // Маркер блока "Замечания к документации"
'%zamechaniya_doc_dok%', // Маркер блока "Основания для замечаний к документации"
'%zamechaniya_vyav%', // Маркер блока "Выявленные и устраненные замечания"
'%zamechaniya_vyav_dok%', // Маркер блока "Основания по выявленным и устраненным замечаниям"
'%po_d50_korrekt%', // Маркер блока "Необходимость корректировки ПО и Д50"
'%po_d50_korrekt_dok%'); // Маркер блока "Основания для необходимости корректировки ПО и Д50"
var
FTrue, Ffalse, Template, NewTemplate, ItemIndex, ItemIndex1, T, R, D, DD, Replese_T, Find_T: OleVariant;
Tbl, L, col: OleVariant;
j: integer;
transgaz : String;
sau : String;
Addr1, Addr2 : OleVariant;
begin
// Запрет выполнения операции, если не загружен info-файл
if (trim(Edit1.Text) = '') Then
begin
if MessageBox(Handle,PChar('Не указан путь к info-файлу!'#13#10'Операция не может быть выполнена!'),PChar('Недопустимое значение полей'),MB_ICONERROR+MB_OK)= mrOk then exit;
end;
// Запрет выполнения операции, если не указан каталог с документами
if (trim(Edit3.Text) = '') Then
begin
if MessageBox(Handle,PChar('Не указан каталог с документами!'#13#10'Операция не может быть выполнена!'),PChar('Недопустимое значение полей'),MB_ICONERROR+MB_OK)= mrOk then exit;
end;
Xlsdoc := CreateOleObject('Excel.Application');
Xlsdoc.Workbooks.Open(Edit1.Text);
Xlsdoc.Visible := False;
transgaz := Xlsdoc.Range['B3'];
sau := Xlsdoc.Range['B2'];
Xlsdoc.Workbooks.Close;
Xlsdoc.Quit;
Xlsdoc:=UnAssigned;
Memo1.Clear;
Memo1.Lines.Add('Соединение с шаблоном технического отчета...');
Application.ProcessMessages;
try
WA1.Connect;
WA1.Visible := False;
Template := EmptyParam;
NewTemplate := False;
FTrue := true;
Ffalse := false;
except
ShowMessage('Не удалось соедениться с шаблоном технического отчета!');
Memo1.Lines.Add('Не удалось соедениться с шаблоном технического отчета!' );
Application.ProcessMessages;
exit;
end;
Memo1.Lines.Add('Создаем технический отчет...');
Application.ProcessMessages;
// Добавляем документ из имеющегося со статусом несохраненного нового документа
try
T := ExtractFilePath(Application.ExeName)+'\Shablon\Tehotchet.dot';
ItemIndex := WA1.Documents.Add(T, NewTemplate, NewTemplate, Template);
WD1.ConnectTo(WA1.Documents.Item(ItemIndex));
except
Memo1.Lines.Add('Не удалось соедениться с шаблоном технического отчета (Tehotchet.dot)! Проверьте расположение файла!' );
Application.ProcessMessages;
ShowMessage('Не удалось соедениться с шаблоном технического отчета (Tehotchet.dot)! Проверьте расположение файла!');
WD1.Application.Selection.EndOf(Template, Template);
WA1.Application.WindowState := wdWindowStateMaximize;
WA1.Application.ScreenUpdating := true;
WA1.Application.ScreenRefresh;
WA1.Visible := true;
WA1.Disconnect;
WD1.Disconnect;
exit;
end;
try
// Количество таблиц в документе и количество строк со столбцами
col := WA1.ActiveDocument.Tables.Count;
for j := 1 to col do
begin
Memo1.Lines.Add('Подключаемся к приложению MS Word...'+Inttostr(j));
Application.ProcessMessages;
tbl := WA1.ActiveDocument.Tables.Item(j); // Присоеденяемся к таблице
end;
L := wdStory; // В начало документа
WA1.Selection.HomeKey(L, EmptyParam);
Memo1.Lines.Add('Заменяем маркеры на текст...' );
Application.ProcessMessages;
Find_T := '%sotrudnik%'; // Текст, который меняем
D := wdFindStop; // Найти один раз
DD := wdReplaceAll; // Замена все
Replese_T := ComboBox1.Text; // Заменить на
WA1.Selection.Find.Execute(Find_T, EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
Replese_T, DD, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
Find_T := '%date_in%'; // Текст, который меняем
Replese_T := DateToStr(DateTimePicker1.Date); // Заменить на
......
WA1.Selection.Find.Execute(Find_T, EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam, D, EmptyParam,
Replese_T, DD, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
WD1.Application.Selection.EndOf(Template, Template);
except
WA1.Visible := true;
WA1.Disconnect;
WD1.Disconnect;
Memo1.Lines.Add('Ошибка!' );
Application.ProcessMessages;
exit;
end;
Memo1.Lines.Add('Экспорт завершен.' );
Application.ProcessMessages;
WA1.Visible := True;
SaveDialog1.DefaultExt := 'doc';
SaveDialog1.Filter := '*.doc|*.doc';
SaveDialog1.FileName := 'Технический_отчет_'+FormatDateTime('ddmmyyyy_hhmm', Now)+'.doc';
Addr1 := SaveDialog1.FileName;
WA1.ActiveDocument.SaveAs(Addr1);
//WD1.SaveAs(ExtractFilePath(Application.ExeName)+'Технический_отчет_'+FormatDateTime('ddmmyyyy_hhmm', Now)+'.doc');
WD1.Disconnect;
WA1.Disconnect;