uexceltools.pas

小银行系统

{单元：uExcelTools
作者： Bill
功能：保存数据集，如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.