用Delphi从Excel表格中提取图像

qcbq4gxm  于 2022-09-21  发布在  其他
关注(0)|答案(2)|浏览(270)

我有一张Excel表格,在几个单元格中,单元格的左上角有一张图片。这些图片的行为就像它们“附加”到一个给定的单元格,因为如果我改变一个单元格的边界,它的图片就会随之移动。

如何使用Delphi提取这些图片并将其保存为文件?

mccptt67

mccptt671#

更新#4操作员提供了迟来的说明,准备一个他一直试图提取的图片的示例:

1)转到nbbclubsites.nl/Club/8000/uitslagen 2)点击“TKDmm,ronde 1[1]”3)点击-14-13/3 4)点击“B.C.den Dungen-1”5)选择De 4和红心符号6)复制Ctrl+C 7)打开Excel并选择单元格(1,1)8)越过Ctrl+V在单元格中看到4,心脏符号锁定左上角

我这样做了,心形符号粘贴到了我的工作表上,没有任何问题。完成此操作后,项目1 Insert Picture中的SavePicture方法将正确提取心脏符号并将其作为.jpg文件保存到磁盘。多!

更新#3回答这个问题的一个问题是,没有关于OP电子表格中的图片是如何插入的信息。到目前为止,已确定了三种不同的方法:

  • 使用Excel的插入选项卡中的插入-图片
  • 使用Excel的插入选项卡中的插入对象
  • 使用选定单元格的上下文菜单中的插入注解

下面我展示了每种方法的代码示例。

1.插入-图片

procedure TForm1.InsertPicture;
begin
  Worksheet.Pictures.Insert('C:UsersmaPicturesphoto-2.JPG');
end;

procedure TForm1.SavePicture;
var
  Picture : OleVariant;
begin
  Picture := Worksheet.Pictures[1];
  Picture.Select;
  Picture.Copy;
  SaveClipboard;
end;

2.插入对象

procedure TForm1.InsertAsObject;
begin
  WorkSheet.OLEObjects.Add(Filename:='C:UsersmaPictureswall.bmp', Link :=False,
    DisplayAsIcon:=False).Select;
end;

procedure TForm1.SaveObjectBmp;
var
  Shape : OleVariant;
begin
  Caption := IntToStr(WorkSheet.OleObjects.Count);
  WorkSheet.OLEObjects[1].Select;
  WorkSheet.OLEObjects[1].CopyPicture;
  Shape := WorkSheet.OLEObjects[1].ShapeRange.Item(1);
  Shape.CopyPicture(xlScreen, xlBitMap);
  SaveClipboard;
end;

3.作为单元格注解插入

procedure TForm1.InsertCommentPicture;
var
  Cell,
  Comment : OleVariant;
begin
  Cell := WorkSheet.Cells.Range['b2', 'b2'];
  Comment := Cell.AddComment;
  Comment.Shape.Fill.UserPicture('C:UsersmaPicturesphoto-2.JPG');
  Comment.Visible := True;
end;

procedure TForm1.SaveCommentPicture;
var
  Cell,
  Comment,
  Shape,
  Picture : OleVariant;
begin
  Cell := WorkSheet.Cells.Range['B2', 'B2'];
  Comment := Cell.Comment;
  Comment.Visible := True;

  Shape := Comment.Shape;
  Shape.CopyPicture(xlScreen, xlBitMap);
  SaveClipBoard;
end;

SaveClipBoard方法和FormCreate方法如下所示。ExcelWorkBookWorkSheet都是表单的OleVariant成员。

procedure TForm1.SaveClipboard;
// With thanks to the author of http://delphi.cjcsoft.net/viewthread.php?tid=46877
var
  myBitmap: TBitmap;
  myJpegImg: TJpegImage;
  SaveFileName: string;
begin
  Caption := IntToStr(Clipboard.FormatCount)  + ':' + IntToStr(Clipboard.Formats[0]);
  SaveFileName := ExtractFilePath(FileName) + 'Saved.Jpg';
  myBitmap := TBitmap.Create;
  myJpegImg := TJpegImage.Create;
  try
    if Clipboard.HasFormat(cf_Bitmap) then
      begin
        myBitmap.Assign(clipboard);
        myJpegImg.Assign(myBitmap);
        myJpegImg.SaveToFile(SaveFileName);
      end
    else
      ShowMessage('No graphic on the clipboard');
  finally
    myBitmap.FreeImage;
    myJpegImg.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Excel := CreateOleObject('Excel.Application');
  Excel.Visible := True;
  FileName := ExtractFilePath(Application.ExeName) + 'PictureBook.Xlsx';
  WorkBook := Excel.Workbooks.Open(FileName);
  WorkSheet := WorkBook.ActiveSheet;
end;
snz8szmq

snz8szmq2#

我知道这是一个非常古老的问题,但希望这对带着同样的问题来到这里的人很有用:我如何才能获得附着图像的细胞,以及如何保存该图像。经过长时间的研究,我发现图片是一张纸上的形状,图片上有“topleftcell.地址”,这是图片链接到的单元格。

保存该图像的代码在给出的答案中。

for i := 1 to sheet.Shapes.Count do
  begin
    picture := Sheet.Pictures(Pictures(i, lcid);
    test := picture.topleftcell.address;
    picture.select;
    picture.Copy;
  end;

相关问题