把數據集保存為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;