把数据集保存为Excel格式的一个实现

核心提示：经常看到有人问如何把Delphi中的数据集导入Excel中，这里提供了一个实现，把数据集保存为Excel格式的一个实现，在做项目时，很多情况下，在外面加入UI接口和错误处理function DataSetToExcel ( DataSet :TDataSet; // 要转换的数据集 FieldTagMax :Inte

经常看到有人问如何把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.