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

// *-*-*-*-*-*-*-*
// SelectToExcel.dpr
// *-*-*-*-*-*-*-*

program SelectToExcel;

uses
  Forms,
  Main in 'Main.pas' {Form1};

{$R *.RES}

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

// *-*-*-*-*-*-*-*
// 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.