delphi 导出到excel的7种方法

本文来自 爱好者8888 的CSDN 博客 ，全文地址请点击：https://blog.csdn.net/kpc2000/article/details/17066823?utm_source=copy

===================================================================================================

第一种方法delphi 快速导出excel

uses ComObj,clipbrd;
function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;
const
      xlNormal=-4143;
var
    y     : integer;
    tsList : TStringList;
    s,filename  :string;
    aSheet :Variant;
    excel :OleVariant;
    savedialog  :tsavedialog;
begin
    Result := true;
    try
         excel:=CreateOleObject(‘Excel.Application‘);
         excel.workbooks.add;
      except
            //screen.cursor:=crDefault;
         showmessage(‘无法调用Excel！‘);
         exit;
    end;
    savedialog:=tsavedialog.Create(nil);
    savedialog.FileName:=sfilename;   //存入文件    savedialog.Filter:=‘Excel文件(*.xls)|*.xls‘;
    if   savedialog.Execute   then
    begin
        if   FileExists(savedialog.FileName)   then
              try
                  if   application.messagebox(‘该文件已经存在，要覆盖吗？‘,‘询问‘,mb_yesno+mb_iconquestion)=idyes
   then
                        DeleteFile(PChar(savedialog.FileName))
                  else
                  begin
                   Excel.Quit;
                   savedialog.free;
                   //screen.cursor:=crDefault;
                   Exit;
                  end;
              except
                  Excel.Quit;
                  savedialog.free;
                  screen.cursor:=crDefault;
                  Exit;
              end;
        filename:=savedialog.FileName;
    end;
    savedialog.free;
    if   filename=‘‘   then
    begin
      result:=true;
      Excel.Quit;
      //screen.cursor:=crDefault;
      exit;
    end;
    aSheet:=excel.Worksheets.Item[1];
    tsList:=TStringList.Create;
    //tsList.Add(‘查询结果‘);   //加入标题    s:=‘‘;   //加入字段名    for y := 0 to adoquery.fieldCount - 1 do
    begin
       s:=s+adoQuery.Fields.Fields[y].FieldName+#9 ;
       Application.ProcessMessages;
    end;
    tsList.Add(s);
    try
        try
            ADOQuery.First;
            While Not ADOQuery.Eof do
            begin
                s:=‘‘;
                for y:=0 to ADOQuery.FieldCount-1 do
                begin
                    s:=s+ADOQuery.Fields[y].AsString+#9;
                    Application.ProcessMessages;
                end;
                tsList.Add(s);
                ADOQuery.next;
            end;
            Clipboard.AsText:=tsList.Text;
        except
            result:=false;
        end;
    finally
        tsList.Free;
    end;
    aSheet.Paste;
    MessageBox(Application.Handle,‘数据导出完毕！‘,‘系统提示‘,MB_ICONINFORMATION
 or MB_OK);
    try
          if   copy(FileName,length(FileName)-3,4)<>‘.xls‘   then
                FileName:=FileName+‘.xls‘;
          Excel.ActiveWorkbook.SaveAs(FileName,xlNormal,‘‘,‘‘,False,False);
    except
      Excel.Quit;
      screen.cursor:=crDefault;
      exit;
    end;
    Excel.Visible   :=   false; //true会自动打开已经保存的excel
    Excel.Quit;
    Excel := UnAssigned;
   
end;

调用:         ToExcel(‘D:\a.xsl‘,QueryToExcel);//路径可以自定义

------------------------------------------------------------------------------------------------- *************************************************************************************************

二; delphi如何导出EXCEL，代码。非第3方控件首先在Uses处加上ComObj

procedure TForm1.Button1Click(Sender: TObject); 
var  h,k:integer;     
Excelid: OleVariant;     
s: string;
begin     
try        
Excelid := CreateOLEObject(‘Excel.Application‘);    
except        
Application.MessageBox(‘Excel没有安装！‘,‘提示信息‘,MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);        
Exit;    
end;      
try     
   ADOQuery1.Close;       
ADOQuery1.SQL.Clear;        
ADOQuery1.SQL.Add(‘select * from jj_department‘);        
ADOQuery1.Open;        
k:=ADOQuery1.RecordCount;         
Excelid.Visible := True;         
Excelid.WorkBooks.Add;         
Excelid.worksheets[1].range[‘A1:c1‘].Merge(True);         
Excelid.WorkSheets[1].Cells[1,1].Value :=‘部门编码表‘ ;         
Excelid.worksheets[1].Range[‘a1:a1‘].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets[1].Range[‘a1:a1‘].VerticalAlignment := $FFFFEFF4;         
Excelid.WorkSheets[1].Cells[2,1].Value := ‘组别编号‘;         
Excelid.WorkSheets[1].Cells[2,2].Value := ‘公司编号‘;         
Excelid.WorkSheets[1].Cells[2,3].Value := ‘组别名称‘;         
Excelid.worksheets[1].Range[‘A1:c1‘].Font.Name := ‘宋体‘;         
Excelid.worksheets[1].Range[‘A1:c1‘].Font.Size := 9;         
Excelid.worksheets[1].range[‘A1:c2‘].font.bold:=true;         
Excelid.worksheets[1].Range[‘A2:c2‘].Font.Size := 9;         
Excelid.worksheets[1].Range[‘A2:c2‘].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets[1].Range[‘A2:c2‘].VerticalAlignment := $FFFFEFF4;         
h:=3;         
ADOQuery1.First;        
while not ADOQuery1.Eof do         
begin           Excelid.WorkSheets[1].Cells[h,1].Value := Adoquery1.FieldByName(‘Fdept_id‘).AsString;           
Excelid.WorkSheets[1].Cells[h,2].Value := Adoquery1.FieldByName(‘Ffdept_id‘).AsString;           
Excelid.WorkSheets[1].Cells[h,3].Value := Adoquery1.FieldByName(‘Fdept_name‘).AsString;           
Inc(h);            
Adoquery1.Next;         
end;         
s := ‘A2:f‘+ IntToStr(k+2);         
Excelid.worksheets[1].Range[s].Font.Name := ‘宋体‘;         
Excelid.worksheets[1].Range[s].Font.size := 9;         
Excelid.worksheets[1].Range[s].Borders.LineStyle := 1;         
Excelid.Quit;          
except        
Application.MessageBox(‘导入数据出错！请检查文件的格式是否正确！‘,MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);    
end;   
MessageBox(GetActiveWindow(),‘EXCEL数据导出成功!‘,MB_OK +MB_ICONWARNING);
end;

三; delphi导出EXCEL

uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,ExtCtrls,Mask,ComCtrls,StdCtrls,Buttons,Grids,ValEdit,IdBaseComponent,CheckLst,excel97,ExcelXP,OleServer,ComObj,excel2000,mmsystem,ShellAPI,ADODB,DB,DBGrids,clipbrd;
 Var
  FExcel:OleVariant; //excel应用程序  FWorkBook :OleVariant; //工作表  Temsheet:OleVariant; //工作薄  FPicture:OleVariant;//图片  tmpstr:String;
  range:variant;//范围  i,j,TemInt:integer;
  TemFileName:String;
begin
  SaveDialog1.Filter:=‘.xls‘;
  if SaveDialog1.Execute then
  begin
    TemFileName:=SaveDialog1.FileName+‘.xls‘;
   
    Screen.Cursor:=CrHourGlass;
    TemInt:=0;
    FExcel:= CreateoleObject(‘excel.Application‘);
    FWorkBook:=FExcel.WorkBooks.Add(-4167); //新的工作表    Temsheet:=FWorkBook.Worksheets.Add;
    Temsheet.Name:=‘利润统计‘;
    Temsheet.Select;
    Temsheet.Columns[1].ColumnWidth:=4;//设置列宽度    Temsheet.Columns[2].ColumnWidth:=10;
    Temsheet.Columns[3].ColumnWidth:=16;
    Temsheet.Columns[4].ColumnWidth:=10;
    Temsheet.Columns[5].ColumnWidth:=10;
    Temsheet.Columns[6].ColumnWidth:=10;
    Temsheet.Columns[7].ColumnWidth:=10;
    Temsheet.Columns[8].ColumnWidth:=10;
    Temsheet.Columns[9].ColumnWidth:=20;
    Temsheet.Columns[10].ColumnWidth:=15;
    range:=Temsheet.Range[Temsheet.cells[1,1],Temsheet.cells[5,2]];//选定表格    range.select;
    range.merge; //合并单元格    tmpstr:=ExtractFilePath(ParamStr(0))+‘tem.jpg‘;   //添加图片    FPicture:=Temsheet.Pictures.Insert(tmpstr);
    FPicture.Left:=20;
    FPicture.Top:=5;
    FPicture.width:=50;
    FPicture.height:=50;
    FPicture:=null;
    range:=Temsheet.Range[Temsheet.cells[2,3],Temsheet.cells[3,4]];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :=‘加粗‘;
    Temsheet.Cells[2,3].HorizontalAlignment:=-4108; //字居中    Temsheet.Cells[2,3]:=ComSName;
    range:=Temsheet.Range[Temsheet.cells[4,Temsheet.cells[4,4]];//选定表格    range.select;
    range.merge;
    Temsheet.Cells[4,3].HorizontalAlignment:=-4108; //字居中    Temsheet.Cells[4,3]:=ComEName;
    range:=Temsheet.Range[Temsheet.cells[2,5],Temsheet.cells[2,6]];//选定表格    range.select;
    range.merge;
    Temsheet.Cells[2,5].HorizontalAlignment:=-4108; //字居中    Temsheet.Cells[2,5]:=ComName;
    Temsheet.Cells[3,5]:=‘联系人：‘;
    Temsheet.Cells[4,5]:=‘电话：‘;
    Temsheet.Cells[4,6]:=ComPhone;
    Temsheet.Cells[5,5]:=‘传真：‘;
    Temsheet.Cells[5,6]:=ComFax;
    range:=Temsheet.Range[Temsheet.cells[6,Temsheet.cells[6,10]];//选定表格    range.select;
    range.merge;
    range:=Temsheet.Range[Temsheet.cells[7,Temsheet.cells[7,2]];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :=‘加粗‘;
    Temsheet.Cells[7,1]:=‘入库信息：‘;
    range:=Temsheet.Range[Temsheet.cells[7,10]];//选定表格    range.select;
    range.merge;
    Temsheet.Cells[8,1]:=‘序号‘;
    Temsheet.Cells[8,1].HorizontalAlignment:=-4108; //字居中    Temsheet.Cells[8,1].Interior.Color:=clGray;     //单元格背景色    range:=Temsheet.Range[Temsheet.cells[8,1],Temsheet.cells[8,1]];//选定表格    range.borders.linestyle:=1;//华线    for i:=0 to DBGrid1.Columns.Count - 1 do
    begin
      Temsheet.Cells[8,i+2]:=DBGrid1.Columns[i].Title.Caption;
      Temsheet.Cells[8,i+2].HorizontalAlignment:=-4108; //字居中      Temsheet.Cells[8,i+2].Interior.Color:=clGray;     //单元格背景色      range:=Temsheet.Range[Temsheet.cells[8,i+2],i+2]];//选定表格      range.borders.linestyle:=1;//华线    end;
    //////////////////////////////////////////////
    j:=0;
    DBGrid1.DataSource.DataSet.First;
    while not DBGrid1.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells[9+j,1].Value:=j+1;
      Temsheet.Cells[9+j,1].HorizontalAlignment:=-4108; //字居中      range:=Temsheet.Range[Temsheet.cells[9+j,Temsheet.cells[9+j,1]];//选定表格      range.borders.linestyle:=1;//华线      for i:=0 to DBGrid1.Columns.Count - 1 do
      begin
        Temsheet.Cells[9+j,i+2].Value:=DBGrid1.Fields[i].AsString;
        range:=Temsheet.Range[Temsheet.cells[9+j,i+2],Temsheet.cells[9+j,i+2]];//选定表格        range.borders.linestyle:=1;//华线      end;
      DBGrid1.DataSource.DataSet.Next;
      j:=j+1;
    end;
    TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;
    range:=Temsheet.Range[Temsheet.cells[TemInt,Temsheet.cells[TemInt,10]];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range[Temsheet.cells[TemInt,2]];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :=‘加粗‘;
    Temsheet.Cells[TemInt,1]:=‘出库信息：‘;
   
    range:=Temsheet.Range[Temsheet.cells[TemInt,10]];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    Temsheet.Cells[TemInt,1]:=‘序号‘;
    Temsheet.Cells[TemInt,1].HorizontalAlignment:=-4108; //字居中    Temsheet.Cells[TemInt,1].Interior.Color:=clGray;     //单元格背景色    range:=Temsheet.Range[Temsheet.cells[TemInt,1]];//选定表格    range.borders.linestyle:=1;//华线    for i:=0 to DBGrid2.Columns.Count - 1 do
    begin
      Temsheet.Cells[TemInt,i+2]:=DBGrid2.Columns[i].Title.Caption;
      Temsheet.Cells[TemInt,i+2].HorizontalAlignment:=-4108; //字居中      Temsheet.Cells[TemInt,i+2].Interior.Color:=clGray;     //单元格背景色      range:=Temsheet.Range[Temsheet.cells[TemInt,i+2]];//选定表格      range.borders.linestyle:=1;//华线    end;
    TemInt:=TemInt+1;
    //////////////////////////////////////////////
    j:=0;
    DBGrid2.DataSource.DataSet.First;
    while not DBGrid2.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells[TemInt+j,1].Value:=j+1;
      Temsheet.Cells[TemInt+j,1].HorizontalAlignment:=-4108; //字居中      range:=Temsheet.Range[Temsheet.cells[TemInt+j,Temsheet.cells[TemInt+j,1]];//选定表格      range.borders.linestyle:=1;//华线      for i:=0 to DBGrid2.Columns.Count - 1 do
      begin
        Temsheet.Cells[TemInt+j,i+2].Value:=DBGrid2.Fields[i].AsString;
        range:=Temsheet.Range[Temsheet.cells[TemInt+j,i+2]];//选定表格        range.borders.linestyle:=1;//华线      end;
      DBGrid2.DataSource.DataSet.Next;
      j:=j+1;
    end;
    TemInt:=TemInt+ DBGrid2.DataSource.DataSet.RecordCount;
    TemInt:=TemInt+1;
   
    range:=Temsheet.Range[Temsheet.cells[TemInt,1]:=‘入库总额：‘;
    Temsheet.Cells[TemInt,3]:=Trim(Edit1.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,4],1]:=‘出库总额：‘;
    Temsheet.Cells[TemInt,3]:=Trim(Edit2.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,1]:=‘总利润：‘;
    Temsheet.Cells[TemInt,3]:=Trim(Edit3.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,10]];//选定表格    range.select;
    range.merge;
   
    range:=Temsheet.Range[Temsheet.cells[7,10]];//选定表格    range.borders.linestyle:=1;//华线    Application.ProcessMessages;
    Screen.Cursor:=CrDefault;
    FExcel.WorkBooks[1].saveas(TemFileName);//保存文件    FExcel.workbooks[1].close; //关闭工作表    Application.ProcessMessages;
    MessageBox(Handle,‘导出成功‘,‘提示‘,MB_OK);
    //FExcel.visible:=true;
    FExcel.quit; //关闭Excel
    FExcel := unassigned;
    shellexecute(0,‘open‘,PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);
 
  end;
end;

四;

uses
  Windows,comobj,clipbrd;四;
procedure TFIND_FM.Button1Click(Sender: TObject);
var
  i,j : integer;
  reportname,wpath : string;
  ExApp1 : TExcelApplication;
  ExWrbk1 : TExcelWorkbook;
  ExWrst1 : TExcelWorksheet;  
begin
  
  if Main_FM.ADOQuery_TEMP.IsEmpty then
    begin
    Showmessage(‘沒有可導出的資料!‘);
    Exit;
    end
  else
    begin
    Main_FM.SaveDialog1.FileName := ‘qcreport‘;
    if  Main_FM.savedialog1.Execute then
      begin
        //savedialog1.FileName := formatdatetime(‘YYYYMMDDHHMMSS‘,now())+‘md_orderqc_list.xls‘;
        reportname :=  formatdatetime(‘YYYYMMDDHHMMSS‘,now())+ExtractFileName(Main_FM.savedialog1.FileName);
        //reportname :=  formatdatetime(‘YYYYMMDDHHMMSS‘,now())+‘‘;
        wpath := ExtractFilePath(Main_FM.savedialog1.FileName);
        //showmessage(wpath);
        try
          ExApp1 := TExcelApplication.Create(application);
          ExWrbk1 := TExcelWorkbook.Create(application);
          ExWrst1 := TExcelWorksheet.Create(application);
          ExApp1.Connect;
        except
          Showmessage(‘電腦沒裝Excel!無法導出!‘);
          Abort;
        end;
        try
          try
          ExApp1.Workbooks.Add(EmptyParam,0);
          ExWrbk1.ConnectTo(ExApp1.Workbooks[1]);
          ExWrst1.ConnectTo(ExWrbk1.Worksheets[1] as _worksheet);
          Main_FM.ADOQuery_TEMP.First;
          for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
            begin
            ExWrst1.Cells.Item[1,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].DisplayName;
            //
            end;
          for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 do
            begin
              for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
                begin
                ExWrst1.Cells.Item[i,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].Value;
                end;
              Main_FM.ADOQuery_TEMP.Next;
            end;
          ExWrst1.SaveAs(wpath+reportname);
          //ExWrst.SaveAs(formatdatetime(‘YYYYMMDDHHMMSS‘,now())+reportname);;
          Showmessage(‘數據已成功導出!‘);
          except
          Showmessage(‘導出失敗!‘);
          abort;
          end;
        finally
          ExApp1.Disconnect;
          ExApp1.Quit;
          ExApp1.Free;
          ExWrbk1.Free;
          ExWrst1.Free;
        end;
      end;
    end;
end;

delphi导出数据至Excel的三种方法及比较闲来无事，跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差，以便比较。（本来使用Timer控件，但是Timer不适合做高精度时间计算）使用TADOConnect，TADOQuery查询数据。方法五：   使用TADOQuery + Varaint方法，循环遍历数据集中数据，直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。在下面代码中没有仔细注意语法（比如没有使用try..finally结构体），如果需要使用，请注意：//使用ADO循环方式保存。

procedure TForm1.btn_WhileClick(Sender: TObject);
var
   Eclapp:variant;
   n:integer;
   filename: string;
   t1,t2: Int64;
begin
   Eclapp := CreateOleObject(‘Excel.Application‘);
   Eclapp.WorkBooks.Add;
   Eclapp.Visible:= False;
   filename :=‘d:\数据1.xls‘;
   lbl2.Caption := ‘0‘;
   if FileExists(fileName) then
     DeleteFile(fileName);
   t1:= GetTickCount;
   qry1.DisableControls;
   qry1.First;
   n:=2;
   while not qry1.Eof do
   begin
     eclapp.cells[n,1] := qry1.Fields[0].AsString;
     eclapp.cells[n,2] := qry1.Fields[1].AsString;
     eclapp.cells[n,3] := qry1.Fields[2].AsString;
     eclapp.cells[n,4] := qry1.Fields[3].AsString;
     //为了简单，只添加了4个栏位     inc(n);
     qry1.Next;
     application.ProcessMessages;
   end;
   qry1.EnableControls;
   t2:= GetTickCount;
   eclapp.visible := false;
   eclapp.Workbooks[1].SaveAs(filename);
   Eclapp.Quit;
   Eclapp:= Unassigned;
   lbl2.Caption := IntToStr(t2 - t1);
end;

方法六：使用OLE方法导入。   先讲TDateSet中的数据保存为二维OLEVariant数组中，再保存到Excel  Sheet中  ///使用OLE方式保存。

procedure
 TForm1.btn_OleVariantClick(Sender: TObject);
var
fileName: string;
xlApp,Sheet: OleVariant;
rowCount,Colcount,index: Integer;
t1,t2: Int64;
function RefToCell(RowID,ColID: Integer): string;
var
    ACount,APos: Integer;
begin
    ACount := ColID div 26;
    APos := ColID mod 26;
    if APos = 0 then
    begin
      ACount := ACount - 1;
      APos := 26;
    end;
    if ACount = 0 then
      Result := Chr(Ord(‘A‘) + ColID - 1) + IntToStr(RowID);
    if ACount = 1 then
      Result := ‘A‘ + Chr(Ord(‘A‘) + APos - 1) + IntToStr(RowID);
    if ACount > 1 then
      Result := Chr(Ord(‘A‘) + ACount - 1) + Chr(Ord(‘A‘) + APos - 1) + IntToStr(RowID);
end;
function getData(ds: TDataSet): OleVariant;
var
    Data: OLEVariant;
    i,j : Integer;
begin
    rowCount := ds.RecordCount;
    colCount := ds.FieldCount;
    Data := VarArrayCreate([1,rowCount + 1,1,colCount],varVariant); //1，rowCount
表示第一维数组的上下标，1，colCount表示第二维数组的上下标    i := 1;
    for j := 0 to colCount - 1 do
    begin
      if not ds.Fields[j].Visible then
        continue;
      Data[i,j + 1] := ds.Fields[j].DisplayLabel;
    end;
    Inc(i);
    ds.DisableControls;
    try
      ds.First;
      while not ds.Eof do
      begin
        for j := 0 to colCount - 1 do
        begin
          Data[i,j + 1] := ds.Fields[j].AsString;
        end;
        Inc(i);
        ds.Next;
        Application.ProcessMessages;
      end;
    finally
      ds.EnableControls;
    end;
    result := Data;
end;
begin
fileName := ‘d:\数据.xls‘;
lbl1.Caption := ‘0‘;
t1:= GetTickCount;//开始计时if FileExists(fileName) then
    DeleteFile(fileName);
xlApp := CreateOleObject(‘Excel.Application‘);
try
    XLApp.Visible := False;
    XLApp.DisplayAlerts := False;
    XLApp.Workbooks.Add;
    // 删除多余的 worksheet
    for index := XLApp.SheetsInNewWorkbook downto 2 do
    begin
      XLApp.Workbooks[1].Worksheets[index].Delete;
    end;
    Sheet := XLApp.Workbooks[1].Worksheets[1];
    index := 1;
    if index <> 0 then
      Sheet := XLApp.Workbooks[1].Worksheets.Add;
    Sheet.Name := qry1.Name;
    //Sheet.Columns.NumberFormatLocal := ‘@‘; //设置单元格式为文本    Sheet.Range[RefToCell(1,1),RefToCell(rowCount + 1,colCount)].Value := getData(qry1);
    XLApp.Workbooks[1].SaveAs(fileName); 
finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      application.ProcessMessages;
      t2:= GetTickCount;
      lbl1.Caption := IntToStr( t2 - t1);
    end;
end;
end;

方法七：现在最流行的文件流方法

.....
var
Form1: TForm1;
arXlsBegin: array[0..5] of Word = ($809,8,0,$10,0);
arXlsEnd: array[0..1] of Word = ($0A,00);
arXlsString: array[0..5] of Word = ($204,0);
arXlsNumber: array[0..4] of Word = ($203,14,0);
arXlsInteger: array[0..4] of Word = ($27E,10,0);
arXlsBlank: array[0..4] of Word = ($201,6,$17);
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
implementation
{$R *.dfm}
//使用文件流procedure incColRow; //增加行列号begin
    if Col = ADataSet.FieldCount - 1 then
      begin
        Inc(Row);
        Col :=0;
      end
    else
      Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据var
L: Word;
begin
     L := Length(AValue);
     arXlsString[1] := 8 + L;
     arXlsString[2] := Row;
     arXlsString[3] := Col;
     arXlsString[5] := L;
     aFileStream.WriteBuffer(arXlsString,SizeOf (arXlsString));
     aFileStream.WriteBuffer(Pointer(AValue)^,L);
     IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数var
    V: Integer;
begin
    arXlsInteger[2] := Row;
    arXlsInteger[3] := Col;
    aFileStream.WriteBuffer(arXlsInteger,SizeOf(arXlsInteger));
    V := (AValue shl 2) or 2;
    aFileStream.WriteBuffer(V,4);
    IncColRow;
end;
procedure WriteFloatCell(AValue: double );//写浮点数begin
     arXlsNumber[2] := Row;
     arXlsNumber[3] := Col;
     aFileStream.WriteBuffer(arXlsNumber,SizeOf(arXlsNumber));
     aFileStream.WriteBuffer(AValue,8);
     IncColRow;
end;
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i,j: integer;
Col,row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
//......
//......
begin
   if FileExists(FileName) then DeleteFile(FileName); //文件存在，先删除      aFileStream := TFileStream.Create(FileName,fmCreate);
   Try    //写文件头　      aFileStream.WriteBuffer(arXlsBegin,SizeOf(arXlsBegin));   //写列头
　      Col := 0; Row := 0;
      if bWriteTitle then
      begin
        for i := 0 to aDataSet.FieldCount - 1 do
          WriteStringCell(aDataSet.Fields[i].FieldName);
      end;       //写数据集中的数据
　　      aDataSet.DisableControls;
      //ABookMark := aDataSet.GetBookmark;
      aDataSet.First ;
      while not aDataSet.Eof do
      begin
        for i := 0 to aDataSet.FieldCount - 1 do
        case ADataSet.Fields[i].DataType of
              ftSmallint,ftInteger,ftWord,ftAutoInc,ftBytes:
              WriteIntegerCell(aDataSet.Fields[i].AsInteger);
              ftFloat,ftCurrency,ftBCD:
              WriteFloatCell(aDataSet.Fields[i].AsFloat)
        else
              WriteStringCell(aDataSet.Fields[i].AsString);
        end;
        aDataSet.Next;
        Application.ProcessMessages;
      end;
      //写文件尾
　      AFileStream.WriteBuffer(arXlsEnd,SizeOf(arXlsEnd));
      //if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
   Finally
     AFileStream.Free;
     ADataSet.EnableControls;
   end;
end;
//调用：procedure TForm1.btn_FileStreamClick(Sender: TObject);
var
t1,t2: Int64;
begin
lbl3.Caption := ‘0‘;
t1:= GetTickCount;
ExportExcelFile(‘d:\数据2.xls‘,true,qry1);
t2:= GetTickCount;
lbl3.Caption:= IntToStr(t2 - t1);
end;