Пересылка данных в ячейки Excel

Mikhail Andronov советует:

Возможно, не все знают, что время пересылки данных из своего приложения в ячейки Excel можно существенно сократить, если пересылать все значения для некоторого диапазона разом. Для этого используется вариантный массив (см. функцию VarArrayCreate). Небольшой пример, который прилагается к письму, все подробно иллюстрирует.

Привожу полностью все файлы проекта:

Main.dfm

object Form1: TForm1
Left = 267 Top = 137 AutoScroll = False Caption = 'Экспорт результатов SELECT в Excel' ClientHeight = 277 ClientWidth = 519

Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Position = poScreenCenter PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 8 Top = 4 Width = 114 Height = 13 Caption = 'Предложение SELECT' end object Label2: TLabel Left = 8 Top = 224 Width = 91 Height = 13 Caption = 'Имя базы данных' end object btnExport: TButton Left = 436 Top = 20 Width = 75 Height = 25 Caption = 'Экспорт' TabOrder = 0 OnClick = btnExportClick end object memSelect: TMemo Left = 8 Top = 20 Width = 417 Height = 197 TabOrder = 1 end object edtDatabaseName: TEdit Left = 8 Top = 240 Width = 413 Height = 21 TabOrder = 2 end object queSelect: TQuery Left = 24 Top = 20 end end

Main.pas

unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Db, DBTables;
type
TForm1 = class(TForm) queSelect: TQuery; btnExport: TButton; memSelect: TMemo; edtDatabaseName: TEdit; Label1: TLabel; Label2: TLabel; procedure btnExportClick(Sender: TObject); private { Private declarations } public { Public declarations } end;
var
Form1: TForm1;
implementation
uses
ComObj; {$R *.DFM}

procedure TForm1.btnExportClick(Sender: TObject);
var
XL, // Приложение Excel TableVals : Variant; // Врем. массив для переноса значений в Excel i, LineCounter, // Счетчик строк для переноса записей в Excel queSelectRecCount, queSelectFieldsCount : Integer; begin
inherited; try Application.ProcessMessages; Screen.Cursor := crSQLWait;
with queSelect do begin SQL.Assign(memSelect.Lines); DatabaseName := edtDatabaseName.Text; Open; {AMA: Экспорт в Excel}
queSelectRecCount := RecordCount; queSelectFieldsCount := FieldCount; TableVals := VarArrayCreate([0, queSelectRecCount-1,//кол-во строк 0, queSelectFieldsCount-1], // кол-во столбцов varOleStr);
First; LineCounter := 0; while not EOF do begin for i := 0 to queSelectFieldsCount-1 do if not Fields[i].IsNull then TableVals[LineCounter, i] := Fields[i].AsString else TableVals[LineCounter, i] := ''; LineCounter := LineCounter + 1; Next; end; Close; end;
try try XL := GetActiveOleObject('Excel.Application'); except XL := CreateOleObject('Excel.Application'); end; except raise Exception.Create('Не могу запустить Excel'); end;
XL.Visible := True; XL.Workbooks.Add; XL.Range[XL.Cells[1,1], XL.Cells[queSelectRecCount, queSelectFieldsCount]].Value := TableVals; XL.Range[XL.Cells[1,1], XL.Cells[queSelectRecCount, queSelectFieldsCount ]].Borders.Weight := 2; finally Screen.Cursor := crDefault; end; end;

end.

SelectToExcel.dpr

program SelectToExcel;

uses
Forms, Main in 'Main.pas' {Form1};
{$R *.RES}

begin
Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

[000845]

Содержание раздела