Советы по Delphi
       

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


советует:

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

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

Main.dfm

object Form1: TForm1
Left = 267Top = 137AutoScroll = FalseCaption = 'Экспорт результатов SELECT в Excel'ClientHeight = 277ClientWidth = 519Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'MS Sans Serif'Font.Style = []OldCreateOrder = FalsePosition = poScreenCenterPixelsPerInch = 96TextHeight = 13object Label1: TLabelLeft = 8Top = 4Width = 114Height = 13Caption = 'Предложение SELECT'endobject Label2: TLabelLeft = 8Top = 224Width = 91Height = 13Caption = 'Имя базы данных'endobject btnExport: TButtonLeft = 436Top = 20Width = 75Height = 25Caption = 'Экспорт'TabOrder = 0OnClick = btnExportClickendobject memSelect: TMemoLeft = 8Top = 20Width = 417Height = 197TabOrder = 1endobject edtDatabaseName: TEditLeft = 8Top = 240Width = 413Height = 21TabOrder = 2endobject queSelect: TQueryLeft = 24Top = 20endend

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, // Приложение ExcelTableVals : Variant; // Врем. массив для переноса значений в Exceli, LineCounter, // Счетчик строк для переноса записей в ExcelqueSelectRecCount,queSelectFieldsCount : Integer;begin
inherited;tryApplication.ProcessMessages;Screen.Cursor := crSQLWait;
with queSelect dobeginSQL.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 dobeginfor i := 0 to queSelectFieldsCount-1 doif not Fields[i].IsNull thenTableVals[LineCounter, i] := Fields[i].AsStringelseTableVals[LineCounter, i] := '';LineCounter := LineCounter + 1;Next;end;Close;end;
trytryXL := GetActiveOleObject('Excel.Application');exceptXL := CreateOleObject('Excel.Application');end;exceptraise 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;finallyScreen.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]



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