Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2009年05月27日] [更新 2013年12月18日]　エクセル操作フォームEx
エクセル操作フォームEx   参考コード類
エクセルの画像や図形の保存
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro + Excel 2010
複数の画像を個別に保存するサンプルは Delphi XE2(UP5)






マウスで選択中の図形類を保存  -  クリップボード使用


クリップボードを使用した図形の保存方法です．現在選択中の図形をメタファイル，ビットマップ，JPEG画像ファイルとして保存します．画像保存ダイアログを表示するようになっています．
エクセルはワード同様，図形や画像だけを保存することはできませんが，こんな方法で保存できるというテストです．


リスト1　 
procedure TplExcelFormEx1.Button1Click(Sender: TObject);
var
  FilePath1   : String;
  FilePath2   : String;
  FilePath3   : String;
  AShape      : Txlf2000Shape;
  imgMetaFile : TMetaFile;
  imgBitmap   : TBitmap;
  imgJpeg     : TJpegImage;
  strText     : String;
begin
  //選択したオブジェクトを取得
  AShape := Txlf2000Shape(xlfExcelApp.Selection[0]);
  //セル範囲などNameプロパティが取得できないもの対策
  //この部分を削除すると選択しているもの全てが対象となる
  try
    strText := AShape.Name;
  except
    MessageBox(Handle, '対象外のオブジェクトです', '情報', MB_ICONINFORMATION);
    exit;
  end;

  //クリップボードに送る
  AShape.Copy;

  //各画像のオブジェクトを生成
  imgMetaFile := TMetaFile.Create;
  imgBitmap  := TBitmap.Create;
  imgJpeg := TJpegImage.Create;

  try
    //保存先フォルダ
    SavePictureDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    SavePictureDialog1.Filter     := 'ImageFiles|*.emf;*.bmp;*.jpg';
    SavePictureDialog1.FileName   := StrText;

    if SavePictureDialog1.Execute then begin
      Update;

      //各々の画像の保存名(フルパス)
      FilePath1 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.emf';
      FilePath2 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.bmp';
      FilePath3 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.jpg';

      //メタファイルを保存
      imgMetaFile.Assign(Clipboard);
      imgMetaFile.SaveToFile(FilePath1);

      //メタファイルをビットマップに変換して保存
      imgBitmap.Width  := imgMetaFile.Width;
      imgBitmap.Height := imgMetaFile.Height;
      imgBitmap.Canvas.Draw(0, 0, imgMetaFile);
      imgBitmap.SaveToFile(FilePath2);

      //ビットマップをJPEGに変換して保存
      imgJpeg.Assign(imgBitmap);
      imgJpeg.SaveToFile(FilePath3);
    end;
  finally
    FreeAndNil(imgMetaFile);
    FreeAndNil(imgBitmap);
    FreeAndNil(imgJpeg);
  end;
end;



図形の名前を指定して保存  -  クリップボード使用


クリップボードを使用した図形の保存方法です．指定した名前の図形をメタファイル，ビットマップ，JPEG画像ファイルとして保存します．画像保存ダイアログを表示するようになっています．


リスト2　 
procedure TplExcelFormEx1.Button2Click(Sender: TObject);
var
  FilePath1   : String;
  FilePath2   : String;
  FilePath3   : String;
  AShape      : Txlf2000Shape;
  imgMetaFile : TMetaFile;
  imgBitmap   : TBitmap;
  imgJpeg     : TJpegImage;
begin
  //図形のオブジェクトを取得
  AShape := xlfExcelSheet.Shapes.Item('Picture 1');
  //クリップボードに送る
  AShape.Copy;

  //各画像のオブジェクトを生成
  imgMetaFile := TMetaFile.Create;
  imgBitmap   := TBitmap.Create;
  imgJpeg     := TJpegImage.Create;

  try
    //保存先フォルダ
    SavePictureDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    SavePictureDialog1.Filter     := 'ImageFiles|*.emf;*.bmp;*.jpg';
    SavePictureDialog1.FileName   := AShape.Name;

    if SavePictureDialog1.Execute then begin
      Update;

      //各々の画像の保存名(フルパス)
      FilePath1 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.emf';
      FilePath2 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.bmp';
      FilePath3 := ChangeFileExt(SavePictureDialog1.FileName, '') + '.jpg';

      //メタファイルを保存
      imgMetaFile.Assign(Clipboard);
      imgMetaFile.SaveToFile(FilePath1);

      //メタファイルをビットマップに変換して保存
      imgBitmap.Width  := imgMetaFile.Width;
      imgBitmap.Height := imgMetaFile.Height;
      imgBitmap.Canvas.Draw(0, 0, imgMetaFile);
      imgBitmap.SaveToFile(FilePath2);

      //ビットマップをJPEGに変換して保存
      imgJpeg.Assign(imgBitmap);
      imgJpeg.SaveToFile(FilePath3);
    end;
  finally
    FreeAndNil(imgMetaFile);
    FreeAndNil(imgBitmap);
    FreeAndNil(imgJpeg);
  end;
end;



選択中の図形や画像の名前の確認方法


選択中の図形や画像の名前は，次のようなコードで確認できます．


図1
図形や画像の名前

リスト3　 
procedure TplExcelFormEx1.Button3Click(Sender: TObject);
var
  AShape : Txlf2000Shape;
begin
  xlfSetFocusExcel;
  try
    AShape := Txlf2000Shape(xlfExcelApp.Selection[0]);
    MessageBox(Handle, PChar(AShape.Name), '情報', MB_ICONINFORMATION);
  except
    //何も選択されていない
  end;
end;



選択した複数の画像を個別に保存  -  クリップボード使用


エクセル操作フォームの使用例ではありませんが，エクセルでコピーした画像を，別のアプリで取得する際の参考です．クリップボードを使用すれば，選択した複数の画像を，個別に取得して保存することができます．
Excel 2007 以降では，クリップボードのデータが ZIP 形式であることを利用しています．
以下のコードは，Delphi XE2 以降専用となっていますが，ZIP 書庫の操作等の部分を書き換えれば，他のバージョンの Delphi でも利用できます．
下のコードでは「図形」は保存できません．保存可能なのは「画像」だけです．また，本サンプルは，Excel 2007 よりも前のブックの場合は機能しません．


図2
複数の画像・図形を選択してコピーする
図3
保存結果
  • 図形は保存されない

リスト4
Delphi XE2 以降用のコード (TZipFile は Delphi XE2 以降で使用可能)　 
//=============================================================================
//  Art::GVML Clipformat形式のクリップボードデータの検出と保存
//  docxまたはxlsx形式の文書でないと動作不可
//
//  ワードの場合
//  [挿入][図]はInllineでもInlineでなくとても保存可能
//  [挿入][図形](オートシェイプ)はInllineでは保存不可
//
//  エクセルの場合
//  画像のみ保存可能
//
//  usesにClipbrd, System.Zip, StrUtilsが必要
//  Delphi XE2で実装されたTZipFileを使用しているが，ZIP書庫が扱えれば何でもよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  CustomDataStr: String = 'Art::GVML Clipformat';
var
  zipStream   : TMemoryStream;
  hBuffer     : THandle;
  pBuffer     : Pointer;
  DataFormat  : UINT;
  ZipClass    : TZipFile;
  DestFileDir : String;
  FileListArr : TArray<string>;
  strText     : String;
begin
  //クリップボードのデータフォーマット形式の値を取得
  DataFormat := RegisterClipboardFormat(PChar(CustomDataStr));

  if Clipboard.HasFormat(DataFormat) then begin
    //その形式だったらクリップボードからZipStreamにデータを取得
    zipStream := TMemoryStream.Create;
    try
      ClipBoard.Open;

      hBuffer := Clipboard.GetAsHandle(DataFormat);
      pBuffer := GlobalLock(hBuffer);

      zipStream.WriteBuffer(pBuffer^, GlobalSize(hBuffer));
      zipStream.SaveToFile(ExtractFilePath(Application.ExeName) + 'Temp.zip');
      GlobalUnlock(hBuffer);
      Clipboard.Close;

      //データ(図・画像)の保存先のフォルダを作成
      DestFileDir := ExtractFilePath(Application.ExeName) + 'Temp';
      ForceDirectories(DestFileDir);

      //Art::GVML Clipformat形式はZip形式なのでZipからデータを取出して保存
      ZipClass := TZipFile.Create;
      try
        zipStream.Position := 0;
        ZipClass.Open(zipStream, zmRead);
        FileListArr := ZipClass.FileNames;
        for strText in FileListArr do begin
          if ContainsText(StrText, 'clipboard/media/image') then begin
            ZipClass.Extract(strText, DestFileDir, False);
          end;
        end;
      finally
        ZipClass.Close;
        FreeAndNil(ZipClass);
      end;
    finally
      FreeAndNil(zipStream);
    end;
  end;
end;

end.


上のコードは，ワード操作フォームEx の画像を保存するサンプルのコードで，以下の部分を削除したものとなっています． 


　　//選択したオブジェクトをクリップボードにコピー
　　wdfWordApp.Selection.Copy;


エクセル操作フォームEx で，ワード操作フォームEx のサンプルのように，選択中のオブジェクトをクリップボードにコピーするには，例えば次のコードを最初に実行します．このコードがエクセルの [コピー] ボタンクリックの代わりになります． 


  //手っ取り早くOleVariant型で処理
  //LSelectionはOleVariant型
  LObjSelection := xlfExcelApp.Selection[0];
  LObjSelection.copy;