经常看到有人问如何把Delphi中的数据集导入Excel中,这里提供了一个实现。
在做项目时,很多情况下,客户需要对程序中数据集再加工,再利用,如报表。 这时,就需要把DataSet导入到一个客户比较熟悉的格式中去。Excel是首选了。
该程序在Delphi4,5下编译通过,已被用在多个项目中。还被集成在笔者所写的一个小组件TDBNavigateButton中
{------------------------------------------------------------------------------------------------- 单元:uExcelTools 作者: Bear 功能:保存数据集,如TTable,TQuery,TClientDataSet等为Excel文件, 包含标题,可以只将一部分字段导出 这一点通过设置DataSet中要不导出字段的Tag值大于某一个值来处理 原理:调用 Microsoft Excel Ole对象 调用方式: Function DataSetToExcel( DataSet:TDataSet;FieldTagMax:Integer; Visible:Boolean;ExcelFileName:String=''): Boolean; --------------------------------------------------------------------------------------------------}
unit UExcelTools;
interface
uses classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils, Db,forms,DBClient,ComObj;
//把数据集导入ExcelSheet的核心函数 function DataSetToExcelSheet ( DataSet :TDataSet; FieldTagMax :Integer; // 字段的Tag值如果大于这个值,就不导出到Excel Sheet :OleVariant ): Boolean;
//实际使用的函数,内部调用了DataSetToExcelSheet,在外面加入UI接口和错误处理 function DataSetToExcel ( DataSet :TDataSet; // 要转换的数据集 FieldTagMax :Integer; // 字段的Tag值如果大于这个值,就不导出到Excel Visible :Boolean; // 是否让做转换工作的Excel可见 ExcelFileName:String='' // Excel文件名,*.xls ): Boolean;
implementation
Function DataSetToExcelSheet(DataSet:TDataSet;FieldTagMax:Integer;Sheet:OleVariant): Boolean; var Row,Col,FieldIndex :Integer; BK:TBookMark; begin Result := False; if not Dataset.Active then exit; BK:=DataSet.GetBookMark; DataSet.DisableControls;
Sheet.Activate; try
// 列标题 Row:=1; Col:=1; for FieldIndex:=0 to DataSet.FieldCount-1 do begin if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then begin Sheet.Cells(Row,Col) :=DataSet.Fields[FieldIndex].DisplayLabel; Inc(Col); end; end; // 表内容 DataSet.First; while Not DataSet.Eof do begin Row:=Row+1; Col:=1; for FieldIndex:=0 to DataSet.FieldCount-1 do begin if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then begin Sheet.Cells(Row,Col):=DataSet.Fields[FieldIndex].AsString; Inc(Col); end; end; DataSet.Next; end;
Result := True; finally DataSet.GotoBookMark(BK); DataSet.EnableControls; end;
end; Function DataSetToExcel( DataSet:TDataSet;FieldTagMax:Integer; Visible:Boolean;ExcelFileName:String=''): Boolean; var ExcelObj, Excel, WorkBook, Sheet: OleVariant; OldCursor:TCursor; SaveDialog:TSaveDialog; begin Result := False; if not Dataset.Active then exit;
OldCursor:=Screen.Cursor; Screen.Cursor:=crHourGlass;
try ExcelObj := CreateOleObject('Excel.Sheet'); Excel := ExcelObj.Application; Excel.Visible := Visible ; WorkBook := Excel.Workbooks.Add ; Sheet:= WorkBook.Sheets[1]; except MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+ '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION); Screen.Cursor:=OldCursor; Exit; end;
Result:=DataSetToExcelSheet(DataSet,FieldTagMax,Sheet) ; if Result then if Not Visible then begin if ExcelFileName<>'' then WorkBook.SaveAs(FileName:=ExcelFileName) else begin SaveDialog:=TSaveDialog.Create(Nil); SaveDialog.Filter := 'Microsoft Excel 文件|*.xls'; Result:=SaveDialog.Execute; UpdateWindow(GetActiveWindow); if Result then WorkBook.SaveAs(FileName:=SaveDialog.FileName); SaveDialog.Free; end; Excel.Quit; end; Screen.Cursor:=OldCursor; end;
end.

|