скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Пересылка данных в ячейки 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.






Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook