Проблема такая. Есть текстовый документ, в котором находятся лицевые счета. Есть файлы *.rtf, в которых находится информация, связанная с этим лицевым счетом (ФИО, дата рождения, сам лицевой счет, ...). В файлах порядка 1000-1500 страниц. Некоторая информация находится в таблицах. Для конкретного лицевого счета информация может располагаться на 1-15 страницах. Алгоритм такой:
1) читаю с текстового файла лицевой счет
2) ищу его в файлах *.rtf
3) выделяю нужную информацию (данные связанные с лицевым счетом)
4) вырезаю их
5) вставляю в новый документ
Так вот проблема в ом, что некоторые таблицы "криво" форматируются при вставке. Допустим таблица было в документе "По все ширине", стала по "левому краю". Ширина столбцов также меняется.
| Код |
MsWord := CreateOleObject('Word.Application');
MsWord.Visible := false;
MsWord.Options.CheckSpellingAsYouType := false;
MsWord.Options.CheckGrammarAsYouType := false;
MsWord.DisplayAlerts := false;
Word1 := CreateOleObject('Word.Application');
Word1.Visible := false;
Word1.Options.CheckSpellingAsYouType := false;
Word1.Options.CheckGrammarAsYouType := false;
doc1 := Word1.Documents.Add();
Word1.Selection.PageSetup.LeftMargin := CentimetersToPoints(1.75);
path := GetCurrentDir + '\' + vid + '\RTF\';
if FindFirst(path + '\*.rtf', faArchive, sr) = 0 then
begin
repeat
if (sr.Name = '.') or (sr.Name = '..') then continue;
AssignFile(f, GetCurrentDir + '\' + vid + '\' + fl);
Reset(f);
Form1.StatusBar1.Panels[1].Text := sr.Name;
doc := MsWord.Documents.Open(path + sr.Name);
doc.Tables.Item(2).Delete;
MsWord.Selection.EndKey(wdStory);
//MsWord.Selection.InsertNewPage;
MsWord.Selection.InsertBreak(Type:=wdPageBreak);
MsWord.Selection.TypeText(str);
while not Eof(f) do
begin
Readln(f, snils);
Delete(snils, 1, 16);
Delete(snils, 12, Length(snils));
if (snils <> '') and (snils[1] <> '-') and (snils[4] = '-') and (snils[8] = '-') then
begin
Form1.StatusBar1.Panels[0].Text := snils;
MsWord.Selection.Find.Forward := True;
MsWord.Selection.Find.Text := snils;
MsWord.Selection.Find.Wrap := 1;
if MsWord.Selection.Find.Execute then
begin
Form1.Memo1.Lines.Add(snils + ' в ' + sr.Name );
sel := MsWord.Selection;
sel.Collapse(wdCollapseStart);
Sleep(2200);
sel.GoToNext(wdGoToPage).Select;
//PageEnd := sel.Start;
Sleep(2200);
sel.GoToPrevious(wdGoToPage).Select;
PageStart := sel.Start;
MsWord.Selection.Find.Forward := True;
MsWord.Selection.Find.Text := str;
MsWord.Selection.Find.Wrap := 1;
kol := 1;
while MsWord.Selection.Find.Execute do
begin
if kol = 2 then
begin
MsWord.Selection.Collapse(wdCollapseStart);
Sleep(2200);
MsWord.Selection.GoToNext(wdGoToPage).Select;
Sleep(2200);
MsWord.Selection.GoToPrevious(wdGoToPage).Select;
PageEnd := MsWord.Selection.Start;
doc.Range(PageStart, PageEnd).Select;
MsWord.Selection.cut;
Word1.Selection.Paste;
//Word1.Selection.InsertNewPage;
Word1.Selection.InsertBreak(Type:=wdPageBreak);
break;
end;
Inc(kol);
end;
end;
end;
end;
doc.SaveAs(path + sr.Name);
doc.Close();
Inc(j);
Form1.ProgressBar2.Position := j;
until Findnext(sr) <> 0;
end;
doc1.SaveAs(GetCurrentDir + '\' + vid + '\' + tip + '\' + tip + '.doc');
doc1.Close();
MsWord.Quit();
Word1.Quit();
|
В 2007 Word'e нормально отображается. В ранних версиях "криво". Заранее спасибо. |