С кодом выходят проблемки, файл создается, открывается, но дальше ничего проверить не могу, пара косячков с синтаксисом, не знаю как поправить:
procedure Tf_main.N7Click(Sender: TObject); var i1, i2, j, R: Integer; WordApp, Table: Variant; fn:string; begin if SaveDialog1.Execute then begin WordApp := CreateOleObject('Word.Application'); // А вот с эти приложением работаем WordApp.Visible := True; // Это можно отключить, я включил, чтоб наблюдать за происходящим WordApp.Documents.Add; // Новый документ WordApp.Selection.Font.Size := 8; for j := 0 to ComponentCount - 1 do if Components[j] is TEdit then with Components[j] as TEdit do begin // Saving Edits { WordApp.Selection.TypeText(Edit1.text); WordApp.Selection.TypeText(#13#10'new');} end else if Components[j] is TStringGrid then with Components[j] as TStringGrid do begin // Saving Grigs WordApp.ActiveDocument.Tables.Add(WordApp.ActiveDocument.Range, RowCount, ColCount);//Ошибка: не удаётся удалить диапазон Table := WordApp.ActiveDocument.Tables.Item(1); Table.Style := 'Сетка таблицы'; for i1:=0 to RowCount-1 do for i2:=0 to ColCount-1 do begin Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1]; WordApp.Visible:=True; end; WordApp.Selection.TypeText(#13#10'new'); end else if Components[j] is TChart then with Components[j] as TChart do begin // Saving Grigs { fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp'; // Тут будет временная картинка Chart.SaveToBitmapFile(fn);//Delphi говорит, что нет такого свойства у TChart WordApp.Selection.InlineShapes.AddOLEObject(ClassType:='Paint.Picture', FileName:=fn, LinkToFile:=False, DisplayAsIcon:=False); DeleteFile(fn); WordApp.Selection.TypeText(#13#10'new'); end; } end; WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc'); end; end;
Вызываю процедуру, открывается ворд, начинается заполнение полей таблицы(она встречается первой), таблица полностью заполняется, в первую ячейку кроме её значения записывается какое-то new(как его убрать знаю) и вылетает ошибка: Не удается удалить диапазон. + С TChartoм не знаю что делать, помогите, пожалуйста.
Не знаю, с чем у тебя там проблема, вот этот код работает прекрасно:
procedure Tf_main.N7Click(Sender: TObject);
var WordApp, Table : Variant;
procedure CommentTable(numRows : integer; const s : string); begin wordapp.selection.MoveDown(wdLine, numRows, EmptyParam); wordapp.selection.TypeParagraph; wordapp.selection.InsertAfter(Name); // снимаем выделение с выведенного текста, // чтобы вывод следующей таблицы не затер этот текст wordapp.selection.MoveDown(wdLine, 1, EmptyParam); wordapp.selection.TypeParagraph; end;
var i1, i2, j, R: Integer; new_doc : Variant; fn:string; numCols, numRows : Integer; s : string; begin if SaveDialog1.Execute then begin WordApp := CreateOleObject('Word.Application'); // С этим приложением работаем WordApp.Visible := True; // Это НЕЛЬЗЯ отключать на Word до 2002, вставка будет работать неправильно!!! new_doc := WordApp.Documents.Add; // Новый документ
for j := 0 to ComponentCount - 1 do begin if Components[j] is TEdit then with Components[j] as TEdit do begin // Saving Edits (* WordApp.Selection.TypeText(Edit1.text); WordApp.Selection.TypeText(#13#10'new'); *) end else if Components[j] is TStringGrid then with Components[j] as TStringGrid do begin // Saving Grigs numCols := ColCount; numRows := RowCount; table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);
for i1:=0 to RowCount-1 do for i2:=0 to ColCount-1 do begin Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1]; end;
Table.Cell(0, 0).Select; // Выводим снизу от таблицы имя компонента. // В принципе, можешь выводить любую информацию. CommentTable(numRows + 1, Name); end else if Components[j] is TChart then begin // Saving Charts fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp'; (Components[j] as TChart).SaveToBitmapFile(fn); WordApp.Selection.TypeParagraph; WordApp.Selection.InlineShapes.AddPicture(FileName:=fn, LinkToFile:=False, SaveWithDocument:=True); DeleteFile(fn); wordapp.selection.InsertAfter('Chart : ' + Name); wordapp.selection.MoveDown(wdLine, 1, EmptyParam); WordApp.Selection.TypeParagraph; end; end; WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc'); WordApp.Quit; WordApp := Unassigned; end; end;
(Delphi 2009 + OfficeXP). Если у тебя у Chart-а нет даже метода SaveToBitmapFile - может, это повод задуматься о переходе на более новую версию (или чарта, или Дельфи)? Для Edit-ов доделаешь сам, я не знаю, что тебе там нужно сохранять.
Единственное НО: теперь нельзя оставлять невидимым word application во время сохранения этого отчета (для некоторых версий Word-а). Это баг, сказать "спасибо" за который можно разработчику Оффиса, т.е., MS: MoveDown Method Behaves Incorrectly When Word Is Hidden
Да. И еще: если ты не хочешь, чтоб у тебя в файл забрасывалась таблица, которая в большинстве своем содержит пустые ячейки (а именно это и происходит с GridRoom, там 99 строк, из которых заполнены - всего 4), то или уменьшай RowCount для этого грида, или работай через VarArrayCreate ( как с ним работать - я показывал вот тут: Отчет Excel ), тоже, заполняй только те строки, в которых есть хотя бы одно значение, зачем пустые-то ячейки создавать?
Спасибо большое, только вот там одна переменная не объявлена: wdLine Насколько я понял wdLine - значение по умолчанию, но не работает, может для его работы нужно что-нибудь включать в Uses?
while not TStringGrid.Eof do - не работает, пробовал сделать так, чтобы новая строчка в таблице появлялась после заполнения предыдущей, но тоже что-то так и не нашел нужного свойства. Помогите, пожалуйста: как сделать чтобы в отчет выводились только заполненные поля?
Его там просто нет, поэтому и не работает. Грид - это не файл. Вот так изменяешь кусок, который обрабатывает StringGrid-ы, и все заработает:
if Components[j] is TStringGrid then with Components[j] as TStringGrid do begin // Saving Grigs numCols := ColCount; numRows := 0;
while Trim(StringReplace(Rows[numRows].Text, #13#10, '', [rfReplaceAll])) <> '' do begin inc(numRows); end;
if numRows > 0 then // Пустая таблица? Пропускаем... begin table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);
for i1:=0 to numRows - 1 do for i2:=0 to ColCount-1 do begin Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1]; end;
Table.Cell(0, 0).Select; // Выводим снизу от таблицы имя компонента. // В принципе, можешь выводить любую информацию. CommentTable(numRows + 1, Name); end end
теперь пустые таблицы вообще не выводятся, а заполненные - переносятся в отчет до тех пор, пока не появится первая пустая строка. Как только она появилась - запись заканчивается. Так что если ты планируешь делать таблицы с пустыми строками в середине - то тебе надо сделать чуть-чуть по другому цикл While: идти с конца таблицы, и пока последние строки пустые - уменьшать NumRows.