Delphi 導出數據至Excel的7種方法

一;

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

 

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

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

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;

 

 

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

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

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