Delphi World - Пересылка данных в ячейки Excel
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пересылка данных в ячейки Excel

Автор: Mikhail Andronov

Новые компьютерные вирусы:
"Виагра" - делает из вашей старой гибкой дискеты - жёсткий диск.
"Монка Левински" - высасывает из вашего жёсткого диска информацию и тут же сообщает всем по сети о случившемся.
"Рональд Рейган" - сохраняет все ваши данные, но забывает, где они находятся.
"Борис Ельцин" - выставляет в биосе, что ваш 486 - это Р-III, обьясняет медленную скорость работы тем, что подцепил легкий вирус, постоянно обновляет системный регистр и драйвера. Проблемы 2000 для него не существует. Его дочерние версии могут тайком перекачивать деньги на зарубежные счета.
"Майк Тайсон" - вырубает ваш компьютер с первых двух байтов.
"Арнольд Шварцнеггер" - Terminate all programs and say -I'LL BE BACK!!!
"Титаник" - показывает вам физиономию Ди-Каприо до тех пор, пока вы не утопите свой PC в ванной со льдом.

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

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


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

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования