如何设置我粘贴到 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”子句(不推荐)。
我在 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”子句(不推荐)。