{方法一:} 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; ------------------------------------------------------------------------------------------------ ************************************************************ {方法三:} 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,3],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,1],Temsheet.cells[6,10]];//选定表格 range.select; range.merge; range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[7,2]];//选定表格 range.select; range.merge; Range.Characters.Font.FontStyle :='加粗'; Temsheet.Cells[7,1]:='入库信息:'; range:=Temsheet.Range[Temsheet.cells[7,3],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],Temsheet.cells[8,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,1],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,1],Temsheet.cells[TemInt,10]];//选定表格 range.select; range.merge; TemInt:=TemInt+1; range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格 range.select; range.merge; Range.Characters.Font.FontStyle :='加粗'; Temsheet.Cells[TemInt,1]:='出库信息:'; range:=Temsheet.Range[Temsheet.cells[TemInt,3],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],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],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,1],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],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,10]];//选定表格 range.select; range.merge; TemInt:=TemInt+1; range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格 range.select; range.merge; Range.Characters.Font.FontStyle :='加粗'; Temsheet.Cells[TemInt,1]:='入库总额:'; Temsheet.Cells[TemInt,3]:=Trim(Edit1.Text); range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格 range.select; range.merge; TemInt:=TemInt+1; range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格 range.select; range.merge; Range.Characters.Font.FontStyle :='加粗'; Temsheet.Cells[TemInt,1]:='出库总额:'; Temsheet.Cells[TemInt,3]:=Trim(Edit2.Text); range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格 range.select; range.merge; TemInt:=TemInt+1; range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格 range.select; range.merge; Range.Characters.Font.FontStyle :='加粗'; Temsheet.Cells[TemInt,1]:='总利润:'; Temsheet.Cells[TemInt,3]:=Trim(Edit3.Text); range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格 range.select; range.merge; range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[TemInt,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; ------------------------------------------------------------------------------------------------ ************************************************************ {方法四:delphi如何导出EXCEL代码,非第3方控件} 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, ADODB, DB, DBGrids, 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; ------------------------------------------------------------------------------------------------ ************************************************************ {方法五:使用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, 0); arXlsEnd: array[0..1] of Word = ($0A, 00); arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0); arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0); arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0); arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $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;