Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年05月24日] [更新 2013年12月12日]　エクセル操作フォームEx
エクセル操作フォームEx
テストプログラム　DBTest
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Excel 2010






データベースから読込み


Delphi 付属の DBDEMOS のデータを読込んでエクセルに表示します．単純にセルに書込んでいくコードと，バリアント配列を使用した場合，Range オブジェクトの CopyFromRecordset メソッドを使用した場合を比較してみました．実行時間を計測して表示します．
筆者の環境では，バリアント配列を使用した場合，約 20 ～ 30 倍の速度となりました．

エクセルのグリッドには，TDBGird の機能はありません．表示したデータを更新するには，セル値の変更イベント等で，データベースの Field に値をセットする必要があります (リアルタイムに処理する場合)．これは，データの表示に TStringGrid を使用する場合と同じです．
エクセルの処理速度の比較，データベースの関係については，以下にも記事があります．


図1
設計時仮面

  • ADO 関係コンポーネントを配置
図2
実行結果

リスト1
メインフォームのコード 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses DBTestUnit;

{$R *.dfm}

//=============================================================================
//  エクセル操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  plExcelFormEx2.ShowModal;
end;

end.


リスト2
継承フォームのコード 
unit DBTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, plExcelEx, ToolWin, ComCtrls, ExtCtrls, DB,
  ADODB;

type
  TplExcelFormEx2 = class(TplExcelFormEx)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Button3: TButton;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  plExcelFormEx2: TplExcelFormEx2;

implementation

uses MMSystem;

{$R *.dfm}

//=============================================================================
//  Formを表示する時の処理
//=============================================================================
procedure TplExcelFormEx2.FormShow(Sender: TObject);
begin
  //スクロール範囲
  xlfScrollArea := 'A1:H80';

  //起動時に表示するブックの指定
  xlfBookFullPath := ExtractFilePath(Application.ExeName) + 'DBTestBook.xls';

  inherited;
end;

//=============================================================================
//  単純にセルにデータを代入する方法
//  xlfExcelSheet.Cellsを,OleVariantでなく,Rangeで定義するとコード補完機能が利
//  用できて便利.速度的にも有利.
//=============================================================================
procedure TplExcelFormEx2.Button1Click(Sender: TObject);
var
  DBPath      : String;
  ConnectStr  : String;
  RecCnt      : Integer;
  i           : Integer;
  j           : Integer;
  StartRow    : Integer;
  StartRowStr : String;
  EndRowStr   : String;
  TStart      : DWORD;
  TEnd        : DWORD;
  ARange      : Txlf2000Range;
begin
  //ADO関係の設定
  //まずデータベースファイルの場所をDBPathに代入
  DBPath := GetEnvironmentVariable('CommonProgramFiles');
  {$IF CompilerVersion > 18.49}
  DBPath := DBPath + '\CodeGear Shared\Data\dbdemos.mdb';
  {$ELSE}
  DBPath := DBPath + '\Borland Shared\Data\dbdemos.mdb';
  {$IFEND}

  ADOConnection1.Connected := False;
  //接続文字列の作成(パスワードなしの場合)
  ConnectStr                      := 'Provider=Microsoft.Jet.OLEDB.4.0';
  ConnectStr                      := ConnectStr + ';Data Source=' + DBPath;
  ADOConnection1.ConnectionString := ConnectStr;
  ADOConnection1.Mode             := cmReadWrite;
  ADOQuery1.Connection            := ADOConnection1;

  //クエリー実行
  //RecCntがレコード数.ADOQuery1.RecordCountでも取得可能
  try
    with ADOQuery1 do begin
      Close;
      SQL.Clear;
      SQL.Add('select * from customer');
      Open;
    end;
  except
    exit;
  end;

  //レコード数
  RecCnt := ADOQuery1.RecordCount;

  //書込み範囲のセルをクリア
  StartRow    := 7;
  StartRowStr := 'C' + IntToStr(StartRow);
  EndRowStr   := 'F' + IntToStr(StartRow + RecCnt - 1);
  xlfClearRange(StartRowStr,EndRowStr);

  LockWindowUpdate(PanelLeft.Handle);

  Screen.Cursor := crHourGlass;
  //開始時刻
  TStart := TimeGetTime;

  ARange := xlfExcelSheet.Cells;
  //3回実行する
  with ADOQuery1 do begin
    for j := 0 to 2 do begin
      First;
      for i:=0 to RecCnt-1 do begin
        ARange.Item[i+7,3].Value := FieldByName('CustNo').AsInteger;
        ARange.Item[i+7,4].Value := FieldByName('Company').AsString;
        ARange.Item[i+7,5].Value := FieldByName('Addr1').AsString;
        ARange.Item[i+7,6].Value := FieldByName('LastInvoiceDate').AsDateTime;
        Next;
      end;
    end;
    Close;
  end;

  //終了時刻
  TEnd := TimeGetTime;
  Screen.Cursor := crDefault;

  LockWindowUpdate(0);
  //実行時間を表示
  Memo1.Text:=IntToStr(TEnd-TStart) + ' ms ';

  //保存したことにする(つまり変更なし)
  xlfBookSaved := True;
end;

//=============================================================================
//  バリアント配列を使用する方法
//  非常に高速になる．この例だと約40倍近くいくかも知れない
//=============================================================================
procedure TplExcelFormEx2.Button2Click(Sender: TObject);
var
  DBPath      : String;
  ConnectStr  : String;
  RecCnt      : Integer;
  FCnt        : Integer;
  i           : Integer;
  j           : Integer;
  StartRow    : Integer;
  StartRowStr : String;
  EndRowStr   : String;
  TStart      : DWORD;
  TEnd        : DWORD;
  OleArray    : OleVariant;
begin
  //ADO関係の設定
  //まずデータベースファイルの場所をDBPathに代入
  DBPath := GetEnvironmentVariable('CommonProgramFiles');
  {$IF CompilerVersion > 18.49}
  DBPath := DBPath + '\CodeGear Shared\Data\dbdemos.mdb';
  {$ELSE}
  DBPath := DBPath + '\Borland Shared\Data\dbdemos.mdb';
  {$IFEND}

  ADOConnection1.Connected := False;
  //接続文字列の作成(パスワードなしの場合)
  ConnectStr                      := 'Provider=Microsoft.Jet.OLEDB.4.0';
  ConnectStr                      := ConnectStr + ';Data Source='+ DBPath;
  ADOConnection1.ConnectionString := ConnectStr;
  ADOConnection1.Mode             := cmReadWrite;
  ADOQuery1.Connection            := ADOConnection1;

  //クエリー実行
  try
    with ADOQuery1 do begin
      Close;
      SQL.Clear;
      SQL.Add('select * from customer');
      Open;
    end;
  except
    exit;
  end;

  //レコード数
  RecCnt := ADOQuery1.RecordCount;
  //項目の数
  FCnt := ADOQuery1.FieldCount;

  //書込み範囲のセルをクリア
  StartRow    := 7;
  StartRowStr := 'C' + IntToStr(StartRow);
  EndRowStr   := 'F' + IntToStr(StartRow + RecCnt - 1);
  xlfClearRange(StartRowStr,EndRowStr);

  LockWindowUpdate(PanelLeft.Handle);

  Screen.Cursor := crHourGlass;
  //開始時刻
  TStart := TimeGetTime;

  //3回実行する
  for j := 0 to 2 do begin
    //Variant配列を作成.高速化のためにLock
    OleArray := VarArrayCreate([0, RecCnt - 1, 0, FCnt -1 ],VarVariant);
    VarArrayLock(OleArray);

    //先頭から配列にデータを代入
    with ADOQuery1 do begin
      First;
      for i:=0 to RecCnt-1 do begin
        OleArray[i,0] := FieldByName('CustNo').AsInteger;
        OleArray[i,1] := FieldByName('Company').AsString;
        OleArray[i,2] := FieldByName('Addr1').AsString;
        OleArray[i,3] := FieldByName('LastInvoiceDate').AsDateTime;
        Next;
      end;
    end;

    //エクセルに配列データを送る
    xlfExcelSheet.Range[StartRowStr,EndRowStr].Value := OleArray;
    //Variant配列をUnLockして空にする
    VarArrayUnLock(OleArray);
    VarClear(OleArray);
  end;
  ADOQuery1.Close;

  //終了時刻
  TEnd := TimeGetTime;
  Screen.Cursor := crDefault;

  LockWindowUpdate(0);
  //実行時間を表示
  Memo2.Text := IntToStr(TEnd-TStart) + ' ms ';

  //保存したことにする(つまり変更なし)
  xlfBookSaved := True;
end;

//=============================================================================
//  RangeオブジェクトのCopyFromRecordsetメソッドを使用した例
//  バリアント配列による方法に近い速度が期待できる
//  Delphiを使う場合，この方法が一番ノーマルな方法かも知れない
//=============================================================================
procedure TplExcelFormEx2.Button3Click(Sender: TObject);
var
  DBPath      : String;
  ConnectStr  : String;
  RecCnt      : Integer;
  i           : Integer;
  StartRow    : Integer;
  StartRowStr : String;
  EndRowStr   : String;
  TStart      : DWORD;
  TEnd        : DWORD;
begin
  //ADO関係の設定
  //まずデータベースファイルの場所をDBPathに代入
  DBPath := GetEnvironmentVariable('CommonProgramFiles');
  {$IF CompilerVersion > 18.49}
  DBPath := DBPath + '\CodeGear Shared\Data\dbdemos.mdb';
  {$ELSE}
  DBPath := DBPath + '\Borland Shared\Data\dbdemos.mdb';
  {$IFEND}

  ADOConnection1.Connected := False;
  //接続文字列の作成(パスワードなしの場合)
  ConnectStr                      := 'Provider=Microsoft.Jet.OLEDB.4.0';
  ConnectStr                      := ConnectStr + ';Data Source=' + DBPath;
  ADOConnection1.ConnectionString := ConnectStr;
  ADOConnection1.Mode             := cmReadWrite;
  ADOQuery1.Connection            := ADOConnection1;

  //クエリー実行
  //RecCntがレコード数.ADOQuery1.RecordCountでも取得可能
  try
    with ADOQuery1 do begin
      Close;
      SQL.Clear;
      SQL.Add('select CustNo, Company, Addr1, LastInvoiceDate from customer');
      Open;
    end;
  except
    exit;
  end;

  //レコード数
  RecCnt := ADOQuery1.RecordCount;

  //書込み範囲のセルをクリア
  StartRow    := 7;
  StartRowStr := 'C' + IntToStr(StartRow);
  EndRowStr   := 'F' + IntToStr(StartRow + RecCnt - 1);
  xlfClearRange(StartRowStr,EndRowStr);

  LockWindowUpdate(PanelLeft.Handle);

  Screen.Cursor := crHourGlass;
  //開始時刻
  TStart := TimeGetTime;

  for i := 1 to 3 do begin
    //ADORecordsetオブジェクトの内容をワークシートにコピー
    xlfExcelSheet.Range[StartRowStr,StartRowStr].
               CopyFromRecordset(ADOQuery1.Recordset, EmptyParam, EmptyParam);
  end;
  ADOQuery1.Close;

  //終了時刻
  TEnd := TimeGetTime;
  Screen.Cursor := crDefault;

  LockWindowUpdate(0);
  //実行時間を表示
  Memo3.Text := IntToStr(TEnd - TStart) + ' ms ';

  //保存したことにする(つまり変更なし)
  xlfBookSaved := True;
end;

end.