Delphi从DBgrid导出Excel

注意rightStr需要用到strutils；

procedure DbGrid2Xls(dbgrd: TDBGrid; fileName: string);

var
  Xls: 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;

//==================优化速度版本=======

procedure DbGrid2XlsEx(dbgrd: TDBGrid; fileName: string);
var
  str:string;
  Xls,sheet: Variant;
  I, L: Integer;
begin
  if LowerCase(RightStr(fileName, 4)) <> '.xls' then
    fileName := fileName + '.xls';
  try
    Xls := CreateOleObject('Excel.application');
    Xls.workbooks.Add(1);
  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
    str := str + dbgrd.Columns[I - 1].Title.Caption + #9;
  end;
  str := str + #13;
  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
       str := str + dbgrd.DataSource.DataSet.FieldByName
          (dbgrd.Columns[I - 1].FieldName).AsString + #9 ;
      end;
      str := str +#13;
      dbgrd.DataSource.DataSet.Next;
    end;
    Clipboard.AsText := str;

    sheet := Xls.Workbooks[1].Worksheets[1];
    sheet.Paste;
  finally
    Xls.workbooks[Xls.workbooks.Count].SaveAS(fileName);
    Xls.activeWorkBook.saved := true;
    Xls.workbooks.close;
    Xls.quit;
    dbgrd.DataSource.DataSet.EnableControls;
  end;
end;