经常看到有人问如何把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;interfaceuses
  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;implementationfunction datasettoexcelsheet(dataset:tdataset;fieldtagmax:integer;sheet:olevariant): boolean;
var
   row,col,fieldindex :integer;
   bk:tbook;
begin
   result := false;
   if not dataset.active then exit;
   bk:=dataset.getbook;
   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.gotobook(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.