如何设置我粘贴到 Excel 中的图片的属性?

How to set properties of a picture I paste in Excel?

我在 TAdvStringGrid 的单元格中有图片 (TBitMap),我想使用 OLEVariant 将此 table 复制到 Excel 文件。下面我将只粘贴几行代码来向您介绍两种方法我可以从特定的 TStringGrid 单元格中粘贴一张图片 'in' Excel 文件的特定单元格:

// 第一种方式

Clipboard.Assign(StringGrid1.GetBitmap(2, 2));
Worksheet.Range['a1','a1'].Select;
Worksheet.Paste;

// 第二种方式

bmp := StringGrid1.GetBitmap(2, 2);
bmp.SaveToFile('test.bmp');
Worksheet.Range['a1','a1'].Select;
Worksheet.Pictures.Insert('test.bmp');

我用引号写了 'in',因为在生成的 Excel sheet 中,粘贴的图像并没有真正附加到我在代码中使用的单元格,也就是说,如果我改变height/width of row/column 相关的单元格,图片不会跟随它 and/or 相应地改变它的大小。

我用谷歌搜索发现 Excel 中的图片属性可以将它们关联并锁定到一个单元格,如果设置为 True(在“设置图片格式”菜单的清单中勾选):

不幸的是,我找不到使用 Delphi 访问这些属性的方法,只有 VBA 个示例。因此,如果您知道如何做到这一点(即使应该使用不同的粘贴方式或 Excel 文档创建方式),请分享,我们将不胜感激。

更新。 1、我提到的VBA代码是:

Dim P As Object
Dim xlApp As Excel.Application
Dim WB As Workbook

Set xlApp = New Excel.Application

With xlApp
     .Visible = False
     .DisplayAlerts = False
End With

Set WB = xlApp.Workbooks.Open(FilePath, , True)

Set P = xlApp.Sheets(1).Pictures.Insert(PicPath)
With P
     With .ShapeRange
          .LockAspectRatio = msoFalse
          .Width = 375
          .Height = 260
     End With
     .Left = xlApp.Sheets(1).cells(y, x).Left
     .Top = xlApp.Sheets(1).cells(y, x).Top
     .Placement = 1
     .PrintObject = True
End With

WB.SaveAs FileName:= NewName, CreateBackup:=False 
WB.Close SaveChanges:=True

xlApp.DisplayAlerts = True
xlApp.Application.Quit

(摘自 OP post

我将您显示的 VBA 代码移植到 Delphi:

uses Excell2000;

procedure TForm1.Button1Click(Sender: TObject);
var
    AWorkbook   : ExcelWorkbook;
    AWorkSheet  : OleVariant;
    ASpecOffset : OleVariant;
    APicture    : OleVariant;
    AShapeRange : OleVariant;
    PicPath     : String;
    FilePath    : String;
    NewName     : String;
const
    Lcid = 0;
begin
    FilePath := 'YourExcelFile.xls';
    NewName  := 'YourGeneratedExcelFile.xls';
    PicPath  := 'YourImage.jpg';

    Memo1.Clear;
    ExcelApplication1.Connect;
    ExcelApplication1.Visible[Lcid] := TRUE;
    try
        // Open() will trigger an EOleException if file not found or
        // other similar error.
        AWorkbook := ExcelApplication1.Workbooks.Open(
                             FilePath,
                             EmptyParam,  // UpdateLinks
                             EmptyParam,  // ReadOnly
                             EmptyParam,  // Format
                             EmptyParam,  // Password
                             EmptyParam,  // WriteResPassword
                             EmptyParam,  // IgnoreReadOnlyRecommended
                             EmptyParam,  // Origin
                             EmptyParam,  // Delimiter
                             EmptyParam,  // Editable
                             EmptyParam,  // Notify
                             EmptyParam,  // Converter
                             EmptyParam,  // AddToMru
                             Lcid);
    except
        on E: EOleException do begin
            Memo1.Lines.Add(E.Message);
            Exit;
        end;
    end;

    if ExcelApplication1.Workbooks.Count < 1 then begin
        Memo1.Lines.Add('No workbook found.');
        Exit;
    end;
    if ExcelApplication1.Worksheets.Count < 1 then begin
        Memo1.Lines.Add('No worksheet found.');
        Exit;
    end;

    // Get hand on first worksheet
    AWorkSheet                  := AWorkBook.WorkSheets[1];
    APicture                    := AWorkSheet.Pictures.Insert(PicPath);
    AShapeRange                 := APicture.ShapeRange;
    AShapeRange.LockaspectRatio := FALSE;
    AShapeRange.Width           := 375;
    AShapeRange.Height          := 260;
    APicture.Left               := AWorkSheet.Cells[4, 5].Left;
    APicture.Top                := AWorkSheet.Cells[4, 5].Top;
    APicture.Placement          := 1;
    APicture.PrintObject        := TRUE;

    AWorkBook.SaveAs(NewName,          // FileName
                     xlExcel7,         // FileFormat
                     EmptyParam,       // Password
                     EmptyParam,       // WriteResPassword
                     EmptyParam,       // ReadOnlyRecommended
                     TRUE,             // CreateBackup
                     xlNoChange,       // AccessMode
                     EmptyParam,       // xlUserResolution, // ConflictResolution
                     EmptyParam,       // AddToMru
                     EmptyParam,       // TextCodepage
                     EmptyParam,       // TextVisualLayout
                     Lcid);            // Local

    // Close the work book
    AWorkBook.Close(FALSE, EmptyParam, EmptyParam, Lcid);
    // If no other workbook still open, close Excel
    if ExcelApplication1.Workbooks.Count < 1 then
        ExcelApplication1.Quit;
    // Disconnect from Excel
    ExcelApplication1.Disconnect;
end;

为了使代码更易于阅读,我使用了中间变量,您可以抑制或使用“with”子句(不推荐)。