将dataset里的数据导出excel,并保存excel表

用Servers组件,如果不将控件free掉,内存里有excel.exe进程。这样
会导致excel不能正常工作。下面一个function是将dataset里的数据导出excel,并保存excel表,大家有空可以加个数据统计什么的。

procedure TFrmMain.WriteExcel(AdsData: TADODataSet; sName, Title: string);
var
  ExcelApplication1: TExcelApplication;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelWorkbook1: TExcelWorkbook;
  i, j: 
integer;
  filename: 
string;
begin
  filename :
= concat(extractfilepath(application.exename), sName, '.xls');
  try
    ExcelApplication1 :
= TExcelApplication.Create(Application);
    ExcelWorksheet1 :
= TExcelWorksheet.Create(Application);
    ExcelWorkbook1 :
= TExcelWorkbook.Create(Application);
    ExcelApplication1.Connect;
  except
    Application.Messagebox(
'Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
    Abort;
  
end;
  try
    ExcelApplication1.Workbooks.Add(EmptyParam, 
0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[
1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[
1as _worksheet);
    AdsData.First;
    
for j := 0 to AdsData.Fields.Count - 1 do
      begin
        ExcelWorksheet1.Cells.item[
3, j + 1] := AdsData.Fields[j].DisplayLabel;
        ExcelWorksheet1.Cells.item[
3, j + 1].font.size := '10';
      end;
    
for i := 4 to AdsData.RecordCount + 3 do
      begin
        
for j := 0 to AdsData.Fields.Count - 1 do
          begin
            ExcelWorksheet1.Cells.item[i, j 
+ 1] :=
                AdsData.Fields[j].Asstring;
            ExcelWorksheet1.Cells.item[i, j 
+ 1].font.size := '10';
          end;
        AdsData.
Next;
      
end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[
12] := Title;
    ExcelWorksheet1.Cells.Item[
12].font.size := '14';
    ExcelWorksheet1.SaveAs(filename);
    Application.Messagebox(pchar(
'数据成功导出' + filename), 'Hello',
      mb_Ok);
  finally
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorksheet1.Free;
    ExcelWorkbook1.Free;
  
end;
end;
posted on 2005-08-04 14:59  wanna  阅读(351)  评论(0编辑  收藏  举报