следующая тема »

[30 Апрель 2024, 14:56:13]

Новости, реклама:

[30 Апрель 2024, 14:56:13]

Новости, реклама:

[Anarchy]

Уже нашел...

Код:

const
  lcid = LOCALE_USER_DEFAULT;
var
  XLApp: TExcelApplication;
  MySheet: TExcelWorksheet;
  MyShape: ExcelXP.Shape;
  img:TJPEGImage;
  bmp:TBitmap;
begin
  if OpenDialog1.Execute then begin
    img:=TJPEGImage.Create;
    bmp:=TBitmap.Create;
    XLApp := TExcelApplication.Create(Self);
    MySheet := TExcelWorksheet.Create(Self);
    try
      XLApp.Connect;
      XLApp.Visible[lcid] := True; 
      MySheet.ConnectTo(XLApp.Workbooks.Open(OpenDialog1.FileName,
      false,false,EmptyParam,
      EmptyParam,EmptyParam,EmptyParam,
      EmptyParam,EmptyParam,EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, true, lcid).ActiveSheet as _Worksheet);
      MySheet.ConnectTo(XLApp.ActiveSheet as _Worksheet);
      CreateDir(OpenDialog1.InitialDir+'Image');
      if MySheet.Shapes.Count > 0 then begin
        for i := 1 to MySheet.Shapes.Count do begin
          MySheet.Shapes.Item(i).CopyPicture(xlScreen,xlBitmap);
          bmp.LoadFromClipboardFormat(CF_BITMAP,ClipBoard.GetAsHandle(cf_Bitmap), 0);
          img.Assign(bmp);
          img.SaveToFile(OpenDialog1.InitialDir+'image\'+inttostr(i)+'.jpg');          
        end; // for i
      end; // if MySheet.Shapes.Count > 0
    finally
      XLApp.UserControl := True;
      MySheet.Free;
      XLApp.Free;
      img.Free;
      bmp.Free;
    end;
  end; // if OpenDialog1.Execute