Адрес этой странички : http://doc-prg.narod.ru/art_00903/art_00903.htm 
Дата обновления: 11.09.2007

© 11.09.2007 Сергей Попов

Excel + Delphi-5.
OLE (COM).
Экспорт открытого набора данных TQuery в Excel

Статью в виде файла (192 кб) можно скачать здесь: art_00903.zip 

При программировании прикладных задач часто бывает необходимо экспортировать информацию (в контексте содержимого какого-либо Delphi-компонента) в Excel.
Один из возможных вариантов обмена информацией с Excel является механизм OLE Automation.
Ниже приведен текст простой функции, иллюстрирующей  экспорт информации в Excel применительно к Delphi-компоненту TQuery.
 

function Query_CopyToExcel(Q : TQuery; SelNameFields : TStrings; Excel : Variant; NumList,NumFirstLine : integer; Head : string) : integer; //Экспорт открытого набора Q данных в Excel //Q - открытый набор данных //SelNameFields - список, где перечислены имена экспортируемых полей открытого набора данных // (если NIL или пуст - выводим все) //Excel - OLE-ссылка на Excel //NumList - номер листа Excel //NumFirstLine - номер строки, начиная с которой выволить информацию //Head - заголовок //Функция возвращает кол-во экспортированных строк из набора данных Var i,NumCol,NumRow : integer; List : Variant; YesListFields : byte; YesNext : byte; begin Result:=0; YesListFields := 0; YesNext := 0; if Q.Active then begin if NumList>0 then begin //Проверяем корректность ссылки на Excel if YesLinkToVariant(Excel) then begin //Получаем ссылку на лист Excel List:=GetListExcel(Excel,NumList); //Проверяем корректность ссылки на лист Excel if YesLinkToVariant(List) then begin if SelNameFields<>NIL then begin if SelNameFields.Count>0 then begin YesListFields:=1; end; end; Head:=Trim(Head); NumCol:=1; NumRow:=NumFirstLine-1; if NumRow<0 then NumRow:=0; if Length(Head)>0 then begin //Выводим заголовок и дату NumRow:=NumRow+1; List.Cells[NumRow,NumCol].Value := #39+Head; List.Cells[NumRow,NumCol].Font.Bold:=1; if NumFirstLine>1 then begin List.Cells[NumFirstLine-1,NumCol].Value := #39+'Date : '+DateTimeToStr(NOW); end; end; NumRow:=NumRow+1; NumRow:=NumRow+1; //========================================= {Выводим информацию} {Сначала заголовок} NumCol:=0; Q.First; for i:=0 to (Q.FieldCount-1) do begin YesNext:=1; if YesListFields>0 then begin //Список экспортируемых полей существует. //Проверяем, можно ли выводить это поле YesNext:=0; if SelNameFields.IndexOf(Q.Fields[i].FieldName)>=0 then begin YesNext:=1; end; end; if YesNext>0 then begin NumCol:=NumCol+1; PutToCellInExcel(List,NumRow,NumCol,1,1,Q.Fields[i].FieldName); end; end; {Теперь информацию} Q.First; while not Q.EOF do begin NumRow:=NumRow+1; Result:=Result+1; NumCol:=0; for i:=0 to (Q.FieldCount-1) do begin YesNext:=1; if YesListFields>0 then begin //Список экспортируемых полей существует. //Проверяем, можно ли выводить это поле YesNext:=0; if SelNameFields.IndexOf(Q.Fields[i].FieldName)>=0 then begin YesNext:=1; end; end; if YesNext>0 then begin NumCol:=NumCol+1; PutToCellInExcel(List,NumRow,NumCol,0,0,#39+Q.Fields[i].AsString); //PutToCellInExcel(List,NumRow,NumCol,0,0,Q.Fields[i].AsString); end; end; Application.ProcessMessages; Q.Next; end; //========================================= end; end; end; end; end;

Здесь дополнительных комментариев не требуется ...

Проверим, как это работает.

Создадим Delphi-проект.

Рис.1. Форма проекта Query_to_Excel.dpr

 Запуск Excel в режиме OLE Automation был подробно рассмотрен  ранее и здесь мы на этом останавливаться не будем.

Создадим обработчик события : нажатие на кнопку "Выполнить".

procedure TForm1.SpeedButton3Click(Sender: TObject); //Открыть набор данных begin // Query1.Close; Query1.SQL.Clear; Query1.SQL.Assign(Memo1.Lines); Query1.Open; end;

Создадим обработчик события : нажатие на кнопку "Экспорт".

procedure TForm1.SpeedButton2Click(Sender: TObject); //Экспорт begin //Проверяем корректность ссылки на Excel if YesLinkToVariant(Excel) then begin if Query1.Active then begin //Экспорт открытого набора данных в лист Excel Query_CopyToExcel(Query1,NIL,Excel,SE_ListNum.Value,2, 'Пример экспорта TQuery в Excel (http://doc-prg.narod.ru/art_00903/art_00903.htm)'); end else begin ShowMessage('Набор данных не открыт ...'); end; end else begin //Ошибка при запуске Excel ShowMessage('Сначала нужно подключиться к Excel ...'); end; end;

Этот текст достаточно прост и не требует доп. пояснений.

Скомпилируем проект и запустим программу на выполнение.

Ниже приведен результат тестирования функции Query_CopyToExcel.

Рис.2. Результат тестирования функции Query_CopyToExcel

Исходные тексты этого проекта можно взять здесь (17 кб) :  query_to_excel.zip

© 11.09.2007 Сергей Попов