WriteExcel

1. uses  OleServer, Excel2000,ComObj;
3. procedure WriteExcel(AdsData: TDataSet;Dbgrid: TDbgrid; sName, Title: string);
4. var
5.   ExcelApplication1: TExcelApplication;
6.   ExcelWorksheet1: TExcelWorksheet;
7.   ExcelWorkbook1: TExcelWorkbook;
8.   nrow,ncol: integer;
9.   filename: string;
10. begin
11.   filename := concat(extractfilepath(application.exename), sName, '.xls');
12.   try
13.     ExcelApplication1 := TExcelApplication.Create(Application);
14.     ExcelWorksheet1 := TExcelWorksheet.Create(Application);
15.     ExcelWorkbook1 := TExcelWorkbook.Create(Application);
16.     ExcelApplication1.Connect;
17.   except
18.     Application.Messagebox('Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
19.     Abort;
20.   end;
21.   try
22.     ExcelApplication1.Workbooks.Add(EmptyParam, 0);
23.     ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
24.     ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
26.     nrow:=2;
27.     for ncol:=2 to dbgrid.Columns.Count+1 do
28.       begin
29.         ExcelWorksheet1.Cells.item[nRow,nCol] := dbgrid.Columns[ncol-2].Title.caption;
30. //        ExcelWorksheet1.Cells.item[nRow,nCol].font.size := '10';
31.       end;
33.     nrow:=nrow+1;
34.     AdsData.First;
35.     while not AdsData.Eof do
36.       begin
37.         for ncol :=2 to dbgrid.Columns.Count+1 do
38.           begin
39.            ExcelWorksheet1.Cells.item[nRow,nCol] :=dbgrid.Fields[ncol-2].AsString;
40. //           ExcelWorksheet1.Cells.item[nRow,nCol].font.size := '10';
41.           end;
42.        AdsData.Next;
43.        nRow:=nRow+1;
44.       end;
45.     ExcelWorksheet1.Columns.AutoFit;
46.     ExcelWorksheet1.Cells.item[1, 2] := Title;
47.     ExcelWorksheet1.Cells.Item[1, 2].font.size := '14';
48.     ExcelWorksheet1.SaveAs(filename);
49.   finally
50.     ExcelApplication1.Disconnect;
51.     ExcelApplication1.Quit;
52.     ExcelApplication1.Free;
53.     ExcelWorksheet1.Free;
54.     ExcelWorkbook1.Free;
55.   end;
56. end;