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







シート選択とイベント


シート選択プロパティ xlfActiveSheet と各イベントの利用例です.シートは 5 つあり,四半期報告の作成を想定しています.xlfSheetProtect メソッドで全シートを保護していますが,入力すべきセル範囲だけは xlfLockRange メソッドでロックを解除しています.xlfLockRange メソッドは論理型の引数でロックとその解除を制御できます.

各々の入力セルには 0 ~ 100 までの [入力規則] が設定してあります.このため,範囲外の値を入力すると警告ダイアログが表示されます.ダイアログを独自のものとするには,[入力規則] の設定を解除して,コードで判断することになります.
また,入力範囲 (中央の罫線のある白い部分) 内にしかカーソルが移動しないようにしているためスクロールもほとんどしません.


図1
設計時画面
図2
実行中の画面

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

interface

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

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

var
  Form1: TForm1;

implementation

uses SelectSheetUnit;

{$R *.dfm}

//=============================================================================
//  エクセル操作フォームEx(の継承フォーム)をモーダル表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  //フォーム表示開始時に開くブック名
  //フォームのOnShowで設定してもよい
  plExcelFormEx2.xlfBookFullPath := 'シート選択テスト.xls';

  //エクセル操作フォームExを表示
  plExcelFormEx2.ShowModal;
end;

end.


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

interface

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

type
  TplExcelFormEx2 = class(TplExcelFormEx)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    NendoStr : String;
    procedure AfterBookOpenEvent(Sender: TObject);
    procedure AfterSheetChangeEvent(SheetName:String);
    procedure CellValueChangeEvent(ARow,ACol: Integer; Value: OleVariant);
    procedure CellChangeEvent(ARow,ACol: Integer; Value: OleVariant);
  end;

var
  plExcelFormEx2: TplExcelFormEx2;

implementation

uses Excel2000;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TplExcelFormEx2.FormShow(Sender: TObject);
begin
  //フォームを表示する時にイベントを定義
  OnAfterExcelBookOpen := AfterBookOpenEvent;
  OnAfterSheetChange   := AfterSheetChangeEvent;
  OnCellPosChange      := CellChangeEvent;
  OnCellValueChange    := CellValueChangeEvent;

  //最初は[第1四半期]シートを表示
  xlfActiveSheetName := '第1四半期';
  xlfActiveCell      := 'D8';

  //元のフォームのOnShowを実行
  inherited;
end;

//=============================================================================
//  ブック表示後のイベント
//
//  ・各シートのタイトル文字列を該当セルに書込む
//  ・カーソルの移動範囲を[C7:F12]に限定(Excel2000以上のみ有効)
//  ・入力位置の移動方向を下に設定
//
//  xlDown等の定数の使用にはusesにExcel2000が必要
//=============================================================================
procedure TplExcelFormEx2.AfterBookOpenEvent(Sender: TObject);
begin
  NendoStr := FormatDateTime('ggge', IncMonth(Now, -2));
  xlfCellValueOnSheet['D4','第1四半期'] := NendoStr + '年度 第1四半期';
  xlfCellValueOnSheet['D4','第2四半期'] := NendoStr + '年度 第2四半期';
  xlfCellValueOnSheet['D4','第3四半期'] := NendoStr + '年度 第3四半期';
  xlfCellValueOnSheet['D4','第4四半期'] := NendoStr + '年度 第4四半期';

  //カーソルの移動範囲の設定(シート全体で有効)
  xlfScrollArea := 'C7:F12';

  //カーソル移動を下方向に許可
  xlfExcelApp.MoveAfterReturn[0] := True;
  xlfExcelApp.MoveAfterReturnDirection[0] := xlDown;

  //現在のアクティブなセル位置を表示
  Panel1.Caption := 'セル位置 ' + xlfActiveCell;

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

//=============================================================================
//  アクティブなシートが変更となった時のイベント
//
//  ・ステータスバーに表示する文字列の設定
//    このステータスバーは継承Formに配置したもの
//  ・保護したシートの入力部分のロックを解除
//=============================================================================
procedure TplExcelFormEx2.AfterSheetChangeEvent(SheetName: String);
begin
  //シートを保護する
  xlfSheetProtect(True);

  if SheetName = '年度計' then begin
    xlfCellValue['D4'] := NendoStr+'年度 年度計';
  end else begin
    //保護されているシートの指定範囲を入力可能とする
    //このxlfLockRangeはDisplayAlerts[LCID] := False;にした場合は無効
    xlfLockRange('C7','F20', False);
  end;

  //現在のアクティブなセル位置を表示
  Panel1.Caption := 'セル位置 ' + xlfActiveCell;
end;

//=============================================================================
//  アクティブなセルが変更となった時のイベント
//  セルの位置をA1形式で表示
//=============================================================================
procedure TplExcelFormEx2.CellChangeEvent(ARow, ACol: Integer;
  Value: OleVariant);
var
  PosStr : String;
begin
  PosStr         := xlfToA1(ARow, ACol);
  Panel1.Caption := 'セル位置 ' + PosStr;

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

//=============================================================================
//  セル値の変更後に発生するイベント
//  20以下の値の時は赤字にする(赤点ですね...)
//
//  このテストシートの入力セルには入力範囲の制限を設けている
//  そのため,範囲外の値を入力すると警告ダイアログを表示する
//=============================================================================
procedure TplExcelFormEx2.CellValueChangeEvent(ARow, ACol: Integer;
  Value: OleVariant);
begin
  if (ARow >= 7) and (ARow <= 12) and (ACol >= 3) and (ACol <= 6) then begin
    if Value <= 20 then begin
      xlfExcelSheet.Cells.Item[ARow, ACol].Font.ColorIndex := 3;
    end else begin
      xlfExcelSheet.Cells.Item[ARow, ACol].Font.ColorIndex := 1;
    end;
  end;

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

//=============================================================================
//  Button1クリックでシートを選択
//  フォーカスをExcelに移動(xlfActiveSheetの設定だけでは移動しない)
//  Button1~Button5までクリックイベントは共有
//
//  Senderを区別する方法はいろいろいあるが,ここでは名前で判定してみた
//  (あまり使わないとは思うが,こんな方法もあるということで)
//=============================================================================
procedure TplExcelFormEx2.Button1Click(Sender: TObject);
begin
  if TButton(Sender).Name = 'Button1' then xlfActiveSheetName := '第1四半期';
  if TButton(Sender).Name = 'Button2' then xlfActiveSheetName := '第2四半期';
  if TButton(Sender).Name = 'Button3' then xlfActiveSheetName := '第3四半期';
  if TButton(Sender).Name = 'Button4' then xlfActiveSheetName := '第4四半期';
  if TButton(Sender).Name = 'Button5' then xlfActiveSheetName := '年度計';
end;

end.