Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年05月27日] [更新 2013年12月18日] エクセル操作フォームEx
   
エクセル操作フォームEx   参考コード類
マクロ文の実行
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro + Excel 2010







開発者のマクロ設定


エクセルをインストールしたデフォルトの状態で,本ページのコードを実行すると「プログラミングによる Visual Basic プロジェクトへのアクセスは信頼性に欠けます.」という,下図のようなダイアログが表示され,マクロが実行できません.


図1

このダイアログを表示させないで,マクロを実行するには,エクセルのオプションで,セキュリティセンタの [マクロの設定] の [開発者向けのマクロ設定] で [VBAオブジェクトプロジェクトモデルへのアクセスを信頼する] をチェックします (Excel 2010 の場合).
他のバージョンのエクセルも同様に設定できます.

この設定は,エクセル全体に有効になります.したがって,他のブックを開いてもマクロの実行が有効になりますから,悪意のあるマクロが含まれているエクセルのブックでも警告なしに実行されてしまうことになります.
作成したアプリケーションを他の方に配布するという意味では,利用者にこの設定操作をさせるのは決して望ましいとは言えないでしょう.開発者が Delphi のコードを作成するために,マクロを作成して,その動作を確認する目的であれば十分に利用価値はあると考えられます.


図2




マクロ文を読込んで実行


Excel VBAのマクロ文を記述してあるテキストファイルを読込んで,そのマクロを実行するサンプルです.この方法の利点は,Excel VBAのコードがそのまま利用可能なことです.

CodeModule の使用には,uses に VBIDE2000 が必要です.



図3
マクロ実行前
図4
マクロの実行結果
  • 指定範囲の最大値は赤
  • 最小値のセルは緑

リスト1 
procedure TplExcelFormEx1.Button1Click(Sender: TObject);
var
  AFName       : WideString;
  VBCodeModule : CodeModule;
begin
  try
    //OfficeのApplication変数と区別するためFormsを明示的に指定
    AFName  := ExtractFilePath(Forms.Application.ExeName) + 'Macro.txt';
    VBCodeModule := xlfExcelApp.ActiveWorkbook.VBProject.
               VBComponents.Add(vbext_ct_StdModule).CodeModule;
    VBCodeModule.AddFromFile(AFName);

    //読込んだマクロを直ちに実行
    xlfExcelApp.Run('TestAAA');
    //最大値と最小値を検査する範囲を指定して実行
    //MaxMinCellColorは引数付きマクロ
    xlfExcelApp.Run('MaxMinCellColor', 'A1:E15');
  except
    raise;
  end;
end;


上のテストで使用したマクロ文です.


リスト2 
' テスト用のマクロ
' 作成者  Mr.XRAY
'
' セル値の合計計算
'
Sub TestAAA
  Range("A6")=100
  Range("B6")=300
  Range("C6")="=A6+B6"
End Sub

'
' 現在の選択セル範囲の最大最小値のセル塗りつぶし色を変える
' コードは「ミコの黄色いおうち」から借用して引数と
' WorkSheets("Sheet1").Range(ARange).Selectの1行を追加

Sub MaxMinCellColor(ByVal ARange as String)
 Dim seru As Range

  Worksheets("Sheet1").Range(ARange).Select
 For Each seru In Selection
  If seru.Value = Application.WorksheetFunction.Max(Selection) Then
   seru.Interior.ColorIndex = 3
  ElseIf seru.Value = Application.WorksheetFunction.Min(Selection) Then
   seru.Interior.ColorIndex = 10
  Else
   seru.Interior.ColorIndex = xlColorIndexNone
  End If
 Next seru
End Sub




マクロ文を実行時に作成して実行


マクロ文を実行時に作成し,そのマクロを実行するサンプルです.
CodeModule の使用には,uses に VBIDE2000 が必要です.


図5
マクロの実行結果
  • 実行前は全てのセルが空白

リスト3 
procedure TplExcelFormEx1.Button2Click(Sender: TObject);
var
  LineNo       : Integer;
  VBCodeModule : CodeModule;

  //-------------------------------------------------------------------------
  //  マクロの行を追加する関数内メソッド
  //  inc(LineNo)では正常動作しない
  //-------------------------------------------------------------------------
  procedure InsertLine(S: String);
  begin
     LineNo := LineNo + 1;
     VBCodeModule.InsertLines(LineNo, S);
  end;
begin
  try
    //新規にマクロ用のModuleを作成する
    //Module1が既にあればModule2という名前となる
    VBCodeModule := xlfExcelBook.VBProject.
                      VBComponents.Add(vbext_ct_StdModule).CodeModule;

    LineNo := 0;
    InsertLine ('''何もしないマクロ ');
    InsertLine ('Sub AAA()');
    InsertLine (' ');
    InsertLine (' ');
    InsertLine ('End Sub');

    InsertLine ('''セルへの数値のセットと計算式のセット例');
    InsertLine ('Sub BBB()');
    InsertLine ('  Range("A5")=123');
    InsertLine ('  Range("B5")=567');
    InsertLine ('  Range("C5")="=A5+B5"');
    InsertLine ('End Sub');

    //マクロBBBを実行
    xlfExcelApp.Run('BBB');
  except
    raise;
  end;
end;




作成したマクロモジュールを削除


上のサンプルでは,エクセルのブックにマクロ文を作成して実行しています.このマクロをブックから削除するコードです.
マクロのモジュール名は,デフォルトでは Module1, Module2, ... という名前になります.

VBComponent の使用には,uses に VBIDE2000 が必要です.



リスト4 
procedure TplExcelFormEx1.Button3Click(Sender: TObject);
var
  VBCompo : VBComponent;
begin
  try
    //削除するModuleの_VBComponent名
    VBCompo := xlfExcelBook.VBProject.VBComponents.Item('Module1');
    //Module1を削除
    xlfExcelBook.VBProject.VBComponents.Remove(VBCompo);

    //削除するModuleの_VBComponent名
    VBCompo := xlfExcelBook.VBProject.VBComponents.Item('Module2');
    //Module2を削除
    xlfExcelBook.VBProject.VBComponents.Remove(VBCompo);
  except
    raise;
  end;
end;