> Ну, как-то вот так (набираю прямо здесь, так что где-то могу и накосячить) :
И тогда можно будет параллельно несколько таких программзапускать и они не будут друг другу мешать?
> Посмотри: С++ Builder6 & Excel
Там как раз всё по-честному сделано.
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;
procedure Tf_main.N7Click(Sender: TObject);(Delphi 2009 + OfficeXP). Если у тебя у Chart-а нет даже метода SaveToBitmapFile - может, это повод задуматься о переходе на более новую версию (или чарта, или Дельфи)? Для Edit-ов доделаешь сам, я не знаю, что тебе там нужно сохранять.
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;
const
wdline = 5;
if Components[j] is TStringGrid thenтеперь пустые таблицы вообще не выводятся, а заполненные - переносятся в отчет до тех пор, пока не появится первая пустая строка. Как только она появилась - запись заканчивается. Так что если ты планируешь делать таблицы с пустыми строками в середине - то тебе надо сделать чуть-чуть по другому цикл While: идти с конца таблицы, и пока последние строки пустые - уменьшать NumRows.
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