注意rightStr需要用到strutils;
procedure DbGrid2Xls(dbgrd: TDBGrid; fileName: string);
varXls: Variant;
I, L: Integer;
begin
if LowerCase(RightStr(fileName, 4)) <> '.xls' then
fileName := fileName + '.xls';
try
Xls := CreateOleObject('Excel.application');
Xls.workbooks.add;
except
ShowMessage('请先安装MICROSOFT EXCEL');
Exit;
end;
if not dbgrd.DataSource.DataSet.IsSequenced then
Exit;
if dbgrd.DataSource.DataSet.IsEmpty then
Exit;
for I := 1 to dbgrd.Columns.Count do
begin
Xls.cells[1, I] := dbgrd.Columns[I - 1].Title.Caption;
end;
L := 2;
try
dbgrd.DataSource.DataSet.DisableControls;
dbgrd.DataSource.DataSet.First;
while not dbgrd.DataSource.DataSet.Eof do
begin
for I := 1 to dbgrd.Columns.Count do
begin
Xls.Cells[L, I].NumberFormat := '@';
Xls.Cells[L, I] := dbgrd.DataSource.DataSet.FieldByName(dbgrd.Columns[I - 1].FieldName).AsString;
end;
inc(L);
dbgrd.DataSource.DataSet.Next;
end;
finally
Xls.WorkBooks[Xls.WorkBooks.Count].SaveAS(filename);
Xls.activeWorkBook.saved := true;
Xls.workbooks.close;
Xls.quit;
dbgrd.DataSource.DataSet.EnableControls;
end;
end;
//====导出excel有图片的代码片段============
Fpicture := Sheet.Pictures.Insert(appPath + 'tmpJpg.jpg');
Fpicture.Width := 102;
Fpicture.Height := 126;
Fpicture.Select;
Fpicture.copy;
Sheet.Cells[L, dbgrd.Columns.Count + 1].select;
Sheet.Pictures.Paste.Select;
Fpicture.delete;