toexcel.~pas

功能特点 根据指定字段将Excel表导入到数据库中

unit ToExcel;
 {
             程序功能    导出平均值到EXCEL中
             程序编写     XIANGWEN
             编写日期     2006-09-25
             函数名称     SAVEXLS
             输入参数     HANLE  类型  THANDLE  说明 父窗体句柄
                          dbs    类型  Tdatasource   说明  数据源名
                          Title   类型  String     说明  Excel sheet名称
             函数返回值   100 操作成功  101 未安装EXCEl  102 导出失败  103 数据集为空
}


interface
  uses
  SysUtils,DBGrids,db,Controls,ComObj,Variants,dialogs,OleServer;
 function savexls(handle:thandle;dbs:Tdatasource;Title:PChar):integer;
implementation
  uses unit1;
//
function savexls(handle:thandle;dbs:Tdatasource;Title:PChar):integer;
var
  XLAPP:Variant;
  Sheet:Variant;
  I,J:Integer;
  PBookMark:TBookmark;
  dbgrid1:tdbgrid;
  savefile:tsavedialog;
  savefilename:string;
begin
  dbgrid1:=tdbgrid.Create(nil);
  dbgrid1.DataSource:=dbs;
  //result:=1;
if DBGrid1.DataSource.DataSet.IsEmpty then begin  exit; result:=103; end;
     savefile:=tsavedialog.Create(nil);
     savefile.DefaultExt:='xls';
     savefile.Filter:='Excel file|*.xls';
     savefile.Title:='选择文件保存位置';
     savefile.Execute;
     savefilename:=savefile.FileName;
    if savefilename='' then  exit;
try
  //Screen.Cursor:=crHourGlass;
  begin
  try
    XLApp:=CreateOleObject('Excel.Application');
    XLAPP.WorkBooks.Add(-4167);
    XlApp.WorkBooks[1].WorkSheets[1].Name:=StrPas(Title);
    Sheet:=XLApp.WorkBooks[1].WorkSheets[StrPas(Title)];
    J:=1;
  except
    result:=101;   //没有安装excel
    Exit;
  end;
  if dbgrid1.DataSource.DataSet.IsEmpty then  begin   result:=103; exit; end;
  with DBGrid1.DataSource.DataSet do begin
    PBookMark:=GetBookmark;
    DisableControls;
    for I:=0 To DBGrid1.Columns.Count-1 do Sheet.Cells[J,I+1]:=DBGrid1.Columns[I].Title.Caption;
    inc(J);
    form1.PBar.Max:=RecordCount;
    form1.PBar.Position:=0;
    First;
    while not Eof do begin
       for I:=0 to DBGrid1.Columns.Count-1 do Sheet.Cells[J,I+1]:=Fields[I].AsString;
       Next;
       Inc(J);
       form1.PBar.Position:=form1.PBar.Position+1;
    end;
    GotoBookmark(PBookMark);
    FreeBookmark(PBookMark);
    EnableControls;
    Sheet.saveas(savefilename);
    XLAPP.ActiveWorkBook.Close(False);
    XLApp.Application.Quit;
    XLApp:= unassigned;
    result:=100;  //导出成功
  end;
  end;
except
    result:=102; //导出失败
  //Screen.Cursor:=crDefault;
end;
end;

end.