Delphi 導出數據至Excel的7種方法【轉】
阿新 • • 發佈：2017-06-19
dbase cas excel classes date pbo item 方式 down
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(‘查詢結果‘); //加入標題
調用: 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 := [email protected]; //設置單元格式為文本 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;
轉自：http://blog.csdn.net/zang141588761/article/details/52275948
一; delphi 快速導出exceluses 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(‘查詢結果‘); //加入標題
調用: 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 := [email protected]; //設置單元格式為文本 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;
Delphi 導出數據至Excel的7種方法【轉】