[ エクセル操作フォームEx ] [ マクロの実行 ]

Delphi Programming / Object Pascal

[掲載 2009年05月24日] [更新 2013年12月12日]　エクセル操作フォームEx

エクセル操作フォームEx テストプログラム　RunMacro
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Excel 2010

マクロの実行

マクロの実行

マクロを実行するプログラムです．あらかじめテスト用のブックで作成したマクロを実行します．表示開始と同時に最初のマクロを実行しています．
Excel 2007 で追加されたブック形式の内，xlsx 形式のブックはマクロが保存できません．マクロが保存できるのは xlsm 形式のブックです．

参考リンク
[マクロ文の実行]

図1
実行結果

四角と丸の描画はブック表示直後
罫線はボタンクリックで描画

リスト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 RunMacroUnit;

{$R *.dfm}

//=============================================================================
//  エクセル操作フォームEx(の継承フォーム)をモーダル表示
//  実行時生成なので，[自動生成]の対象から除外しておく
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  plExcelFormEx2 := TplExcelFormEx2.Create(Self);
  try
    //ブックファイル名
    plExcelFormEx2.xlfBookFullPath := 'MacroTestBook.xls';
    plExcelFormEx2.ShowModal;
    Update;
  finally
    FreeAndNil(plExcelFormEx2);
  end;
end;

リスト2
表示する継承フォームのコード

unit RunMacroUnit;

interface

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

type
  TplExcelFormEx2 = class(TplExcelFormEx)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  plExcelFormEx2: TplExcelFormEx2;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//  マクロを実行
//=============================================================================
procedure TplExcelFormEx2.FormShow(Sender: TObject);
begin
  //元のOnShowを実行
  inherited;

  //直ちにマクロを実行
  try
    xlfExcelApp.Run('TestMacro1');
  except
  end;
end;

//=============================================================================
//  終了時にはブック変更なしにして保存しない
//=============================================================================
procedure TplExcelFormEx2.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  xlfBookSaved := True;

  //元のOnCloseQueryを実行
  inherited;
end;

//=============================================================================
//  別のマクロを実行
//=============================================================================
procedure TplExcelFormEx2.Button1Click(Sender: TObject);
begin
  xlfExcelApp.ScreenUpdating[0] := False;
  try
    xlfExcelApp.Run('TestMacro2');
  except
  end;
  xlfExcelApp.ScreenUpdating[0] := True;
end;

end.

リスト3
エクセルのマクロのコード．エクセルで，上の図形と罫線を描画するコードを記録したマクロのコード．上のテストプログラムはこのコードを実行する．

Sub TestMacro1()
'
' Macro1 Macro
' マクロ記録日 : 2003/1/23  ユーザー名 : Mr.XRAY
'
'
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                                54.75, 27#, 182.25, 142.5). _
        Select
    Selection.ShapeRange.IncrementLeft -8.25
    Selection.ShapeRange.IncrementTop 3#
    ActiveSheet.Shapes.AddShape(msoShapeOval, _
                                113.25,60.75,200.25,180.75).Select
    Selection.ShapeRange.IncrementLeft 1.5
    Selection.ShapeRange.IncrementTop -28.5
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 42
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 42
    Selection.ShapeRange.Fill.Transparency = 0.5
    Selection.ShapeRange.Line.Weight = 1#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Range("A1").Select
End Sub
Sub TestMacro2()
'
' Macro2 Macro
' マクロ記録日 : 2003/1/23  ユーザー名 : Mr.XRAY
'
'
    Range("B15:G26").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
End Sub