Delphi导出数据至Excel的7种方法

OStack程序员社区-中国程序员成长平台 › 门户 › 编程›综合其他

原作者: [db:作者] 来自: [db:来源] 收藏邀请

一;

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

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,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;

--------------------------------------------------------------------------------------------------------------------

********************************************************************************************************************

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

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;

--------------------------------------------------------------------------------------------------

**************************************************************************************************

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;

-------------------------------------------------------------------------------------------------------

*******************************************************************************************************

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

.....

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;

//调用：

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;

http://blog.csdn.net/zang141588761/article/details/52275948

鲜花

握手

雷人

路过

鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

delphixe10.4新功能介绍发布时间：2022-07-18

禁止Delphi2010检测新版本发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：19235|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：10000|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8331|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8701|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8646|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9671|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8632|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：8005|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8667|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7540|2022-11-06

客服电话

电子邮件

Delphi导出数据至Excel的7种方法

请发表评论

全部评论

上一篇：

下一篇：

bradtraversy/iweather: Ionic 3 mobile we

joaomh/curso-de-matlab

断牙刷新位置时间（断牙属性及刷新位置介绍

Matlab常用函数集锦

rugk/mastodon-simplified-federation: Sim

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

SimpleSoftwareIO/simple-sms: Send and re

关于我们

产品与服务

解决方案

139-2527-9053