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;
constxlNormal=-4143;
vary : integer;tsList : TStringList;s,filename :string;aSheet :Variant;excel :OleVariant;savedialog :tsavedialog;
beginResult := true;tryexcel:=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 thenbeginif FileExists(savedialog.FileName) thentryif application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyesthenDeleteFile(PChar(savedialog.FileName))elsebeginExcel.Quit;savedialog.free;//screen.cursor:=crDefault;Exit;end;exceptExcel.Quit;savedialog.free;screen.cursor:=crDefault;Exit;end;filename:=savedialog.FileName;end;savedialog.free;if filename='' thenbeginresult:=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 dobegins:=s+adoQuery.Fields.Fields[y].FieldName+#9 ;Application.ProcessMessages;end;tsList.Add(s);trytryADOQuery.First;While Not ADOQuery.Eof dobegins:='';for y:=0 to ADOQuery.FieldCount-1 dobegins:=s+ADOQuery.Fields[y].AsString+#9;Application.ProcessMessages;end;tsList.Add(s);ADOQuery.next;end;Clipboard.AsText:=tsList.Text;exceptresult:=false;end;finallytsList.Free;end;aSheet.Paste;MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATIONor MB_OK);tryif copy(FileName,length(FileName)-3,4)<>'.xls' thenFileName:=FileName+'.xls';Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);exceptExcel.Quit;screen.cursor:=crDefault;exit;end;Excel.Visible := false; //true会自动打开已经保存的excelExcel.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
usesWindows, 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;VarFExcel:OleVariant; //excel应用程序 FWorkBook :OleVariant; //工作表 Temsheet:OleVariant; //工作薄 FPicture:OleVariant;//图片 tmpstr:String;range:variant;//范围 i,j,TemInt:integer;TemFileName:String;
beginSaveDialog1.Filter:='.xls';if SaveDialog1.Execute thenbeginTemFileName:=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 dobeginTemsheet.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 dobeginTemsheet.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 dobeginTemsheet.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 dobeginTemsheet.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 dobeginTemsheet.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 dobeginTemsheet.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; //关闭ExcelFExcel := unassigned;shellexecute(0,'open',PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);end;
end;
四;
usesWindows, 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);
vari,j : integer;reportname, wpath : string;ExApp1 : TExcelApplication;ExWrbk1 : TExcelWorkbook;ExWrst1 : TExcelWorksheet;
beginif Main_FM.ADOQuery_TEMP.IsEmpty thenbeginShowmessage('沒有可導出的資料!');Exit;endelsebeginMain_FM.SaveDialog1.FileName := 'qcreport';if Main_FM.savedialog1.Execute thenbegin//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);tryExApp1 := TExcelApplication.Create(application);ExWrbk1 := TExcelWorkbook.Create(application);ExWrst1 := TExcelWorksheet.Create(application);ExApp1.Connect;exceptShowmessage('電腦沒裝Excel!無法導出!');Abort;end;trytryExApp1.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 dobeginExWrst1.Cells.Item[1,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].DisplayName;//end;for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 dobeginfor j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 dobeginExWrst1.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('數據已成功導出!');exceptShowmessage('導出失敗!');abort;end;finallyExApp1.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);
varEclapp:variant;n:integer;filename: string;t1,t2: Int64;
beginEclapp := CreateOleObject('Excel.Application');Eclapp.WorkBooks.Add;Eclapp.Visible:= False;filename :='d:\数据1.xls';lbl2.Caption := '0';if FileExists(fileName) thenDeleteFile(fileName);t1:= GetTickCount;qry1.DisableControls;qry1.First;n:=2;while not qry1.Eof dobegineclapp.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方式保存。
procedureTForm1.btn_OleVariantClick(Sender: TObject);
var
fileName: string;
xlApp, Sheet: OleVariant;
rowCount, Colcount, index: Integer;
t1,t2: Int64;
function RefToCell(RowID, ColID: Integer): string;
varACount, APos: Integer;
beginACount := ColID div 26;APos := ColID mod 26;if APos = 0 thenbeginACount := ACount - 1;APos := 26;end;if ACount = 0 thenResult := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);if ACount = 1 thenResult := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);if ACount > 1 thenResult := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
function getData(ds: TDataSet): OleVariant;
varData: OLEVariant;i,j : Integer;
beginrowCount := 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 dobeginif not ds.Fields[j].Visible thencontinue;Data[i,j + 1] := ds.Fields[j].DisplayLabel;end;Inc(i);ds.DisableControls;tryds.First;while not ds.Eof dobeginfor j := 0 to colCount - 1 dobeginData[i,j + 1] := ds.Fields[j].AsString;end;Inc(i);ds.Next;Application.ProcessMessages;end;finallyds.EnableControls;end;result := Data;
end;
begin
fileName := 'd:\数据.xls';
lbl1.Caption := '0';
t1:= GetTickCount;//开始计时if FileExists(fileName) thenDeleteFile(fileName);
xlApp := CreateOleObject('Excel.Application');
tryXLApp.Visible := False;XLApp.DisplayAlerts := False;XLApp.Workbooks.Add;// 删除多余的 worksheetfor index := XLApp.SheetsInNewWorkbook downto 2 dobeginXLApp.Workbooks[1].Worksheets[index].Delete;end;Sheet := XLApp.Workbooks[1].Worksheets[1];index := 1;if index <> 0 thenSheet := 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);
finallyif not VarIsEmpty(XLApp) thenbeginXLApp.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; //增加行列号beginif Col = ADataSet.FieldCount - 1 thenbeginInc(Row);Col :=0;endelseInc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据var
L: Word;
beginL := 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);//写整数varV: Integer;
beginarXlsInteger[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 );//写浮点数beginarXlsNumber[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;
//......
//......
beginif FileExists(FileName) then DeleteFile(FileName); //文件存在，先删除 aFileStream := TFileStream.Create(FileName, fmCreate);Try //写文件头 aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); //写列头Col := 0; Row := 0;if bWriteTitle thenbeginfor i := 0 to aDataSet.FieldCount - 1 doWriteStringCell(aDataSet.Fields[i].FieldName);end; //写数据集中的数据aDataSet.DisableControls;//ABookMark := aDataSet.GetBookmark;aDataSet.First ;while not aDataSet.Eof dobeginfor i := 0 to aDataSet.FieldCount - 1 docase ADataSet.Fields[i].DataType offtSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:WriteIntegerCell(aDataSet.Fields[i].AsInteger);ftFloat, ftCurrency, ftBCD:WriteFloatCell(aDataSet.Fields[i].AsFloat)elseWriteStringCell(aDataSet.Fields[i].AsString);end;aDataSet.Next;Application.ProcessMessages;end;//写文件尾AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));//if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);FinallyAFileStream.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;
