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

Возможно, не все знают, что время пересылки данных из своего приложения в ячейки 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

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

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]