时间戳

首页 > 解决方案 > 如何设置我在 Excel 中粘贴的图片的属性？

excel - 如何设置我在 Excel 中粘贴的图片的属性？

问题描述

我在 TAdvStringGrid 的单元格中有图片 (TBitMap)，我想使用 OLEVariant 将此表复制到 Excel 文件中。下面我将仅粘贴几行代码，向您介绍两种方法，我可以将一张图片从特定的 TStringGrid 单元格粘贴到 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 工作表中，粘贴的图像并没有真正附加到我在代码中使用的单元格，也就是说，如果我更改与单元格相关的行/列的高度/宽度，图片将不要跟随它和/或相应地改变它的大小。

我用谷歌搜索了 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 帖子）

标签： exceldelphi

解决方案

我将您显示的 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”子句的中间变量（不推荐）。

推荐阅读