Delphi 导出数据至Excel的7种方法
<p>一;</p><div>delphi 快速导出excel</div>
<div> </div>
<div>uses ComObj,clipbrd;</div>
<div> </div>
<div>function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;</div>
<div>const</div>
<div>xlNormal=-4143;</div>
<div>var</div>
<div>y : integer;</div>
<div>tsList : TStringList;</div>
<div>s,filename :string;</div>
<div>aSheet :Variant;</div>
<div>excel :OleVariant;</div>
<div>savedialog :tsavedialog;</div>
<div>begin</div>
<div>Result := true;</div>
<div>try</div>
<div>excel:=CreateOleObject('Excel.Application');</div>
<div>excel.workbooks.add;</div>
<div>except</div>
<div>//screen.cursor:=crDefault;</div>
<div>showmessage('无法调用Excel!');</div>
<div>exit;</div>
<div>end;</div>
<div>savedialog:=tsavedialog.Create(nil);</div>
<div>savedialog.FileName:=sfilename; //存入文件</div>
<div>savedialog.Filter:='Excel文件(*.xls)|*.xls';</div>
<div>if savedialog.Execute then</div>
<div>begin</div>
<div>if FileExists(savedialog.FileName) then</div>
<div>try</div>
<div>if application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes then</div>
<div>DeleteFile(PChar(savedialog.FileName))</div>
<div>else</div>
<div>begin</div>
<div>Excel.Quit;</div>
<div>savedialog.free;</div>
<div>//screen.cursor:=crDefault;</div>
<div>Exit;</div>
<div>end;</div>
<div>except</div>
<div>Excel.Quit;</div>
<div>savedialog.free;</div>
<div>screen.cursor:=crDefault;</div>
<div>Exit;</div>
<div>end;</div>
<div>filename:=savedialog.FileName;</div>
<div>end;</div>
<div>savedialog.free;</div>
<div>if filename='' then</div>
<div>begin</div>
<div>result:=true;</div>
<div>Excel.Quit;</div>
<div>//screen.cursor:=crDefault;</div>
<div>exit;</div>
<div>end;</div>
<div>aSheet:=excel.Worksheets.Item;</div>
<div>tsList:=TStringList.Create;</div>
<div>//tsList.Add('查询结果'); //加入标题</div>
<div> </div>
<div>s:=''; //加入字段名</div>
<div>for y := 0 to adoquery.fieldCount - 1 do</div>
<div>begin</div>
<div>s:=s+adoQuery.Fields.Fields.FieldName+#9 ;</div>
<div>Application.ProcessMessages;</div>
<div>end;</div>
<div>tsList.Add(s);</div>
<div>try</div>
<div>try</div>
<div>ADOQuery.First;</div>
<div>While Not ADOQuery.Eof do</div>
<div>begin</div>
<div>s:='';</div>
<div>for y:=0 to ADOQuery.FieldCount-1 do</div>
<div>begin</div>
<div>s:=s+ADOQuery.Fields.AsString+#9;</div>
<div>Application.ProcessMessages;</div>
<div>end;</div>
<div>tsList.Add(s);</div>
<div> </div>
<div>ADOQuery.next;</div>
<div>end;</div>
<div>Clipboard.AsText:=tsList.Text;</div>
<div>except</div>
<div>result:=false;</div>
<div>end;</div>
<div>finally</div>
<div>tsList.Free;</div>
<div>end;</div>
<div>aSheet.Paste;</div>
<div>MessageBox(Application.Handle,'数据导出完毕!','系统提示',MB_ICONINFORMATION or MB_OK);</div>
<div>try</div>
<div>if copy(FileName,length(FileName)-3,4)<>'.xls' then</div>
<div>FileName:=FileName+'.xls';</div>
<div>Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);</div>
<div>except</div>
<div>Excel.Quit;</div>
<div>screen.cursor:=crDefault;</div>
<div>exit;</div>
<div>end;</div>
<div>Excel.Visible := false; //true会自动打开已经保存的excel</div>
<div>Excel.Quit;</div>
<div>Excel := UnAssigned;</div>
<div> </div>
<div>end;</div>
<div> </div>
<div> </div>
<div>调用:</div>
<div>ToExcel('D:\a.xsl',QueryToExcel);//路径可以自定义</div>
<div> </div>
<div> </div>
<div> </div>
<div>-------------------------------------------------------------------------------------------------</div>
<div>*************************************************************************************************</div>
<div>二;</div>
<div>delphi如何导出EXCEL,代码。非第3方控件</div>
<div> </div>
<div>首先在Uses处加上ComObj</div>
<div> </div>
<div>procedure TForm1.Button1Click(Sender: TObject);</div>
<div>var h,k:integer;</div>
<div>Excelid: OleVariant;</div>
<div>s: string;</div>
<div>begin</div>
<div>try</div>
<div>Excelid := CreateOLEObject('Excel.Application');</div>
<div>except</div>
<div>Application.MessageBox('Excel没有安装!', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);</div>
<div>Exit;</div>
<div>end;</div>
<div>try</div>
<div>ADOQuery1.Close;</div>
<div>ADOQuery1.SQL.Clear;</div>
<div>ADOQuery1.SQL.Add('select * from jj_department');</div>
<div>ADOQuery1.Open;</div>
<div>k:=ADOQuery1.RecordCount;</div>
<div>Excelid.Visible := True;</div>
<div>Excelid.WorkBooks.Add;</div>
<div>Excelid.worksheets.range['A1:c1'].Merge(True);</div>
<div>Excelid.WorkSheets.Cells.Value :='部门编码表' ;</div>
<div>Excelid.worksheets.Range['a1:a1'].HorizontalAlignment := $FFFFEFF4;</div>
<div>Excelid.worksheets.Range['a1:a1'].VerticalAlignment := $FFFFEFF4;</div>
<div>Excelid.WorkSheets.Cells.Value := '组别编号';</div>
<div>Excelid.WorkSheets.Cells.Value := '公司编号';</div>
<div>Excelid.WorkSheets.Cells.Value := '组别名称';</div>
<div>Excelid.worksheets.Range['A1:c1'].Font.Name := '宋体';</div>
<div>Excelid.worksheets.Range['A1:c1'].Font.Size := 9;</div>
<div>Excelid.worksheets.range['A1:c2'].font.bold:=true;</div>
<div>Excelid.worksheets.Range['A2:c2'].Font.Size := 9;</div>
<div>Excelid.worksheets.Range['A2:c2'].HorizontalAlignment := $FFFFEFF4;</div>
<div>Excelid.worksheets.Range['A2:c2'].VerticalAlignment := $FFFFEFF4;</div>
<div>h:=3;</div>
<div>ADOQuery1.First;</div>
<div>while not ADOQuery1.Eof do</div>
<div>begin Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Fdept_id').AsString;</div>
<div>Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Ffdept_id').AsString;</div>
<div>Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Fdept_name').AsString;</div>
<div>Inc(h);</div>
<div>Adoquery1.Next;</div>
<div>end;</div>
<div>s := 'A2:f'+ IntToStr(k+2);</div>
<div>Excelid.worksheets.Range.Font.Name := '宋体';</div>
<div>Excelid.worksheets.Range.Font.size := 9;</div>
<div>Excelid.worksheets.Range.Borders.LineStyle := 1;</div>
<div>Excelid.Quit;</div>
<div>except</div>
<div>Application.MessageBox('导入数据出错!请检查文件的格式是否正确!', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);</div>
<div>end;</div>
<div>MessageBox(GetActiveWindow(), 'EXCEL数据导出成功!', '提示信息', MB_OK +MB_ICONWARNING);</div>
<div>end;</div>
<div> </div>
<div> </div>
<div>-----------------------------------------------------------------------------------------------------------------------------------------------</div>
<div>****************************************************************************************************************************************</div>
<div>三;</div>
<div>delphi导出EXCEL</div>
<div> </div>
<div>uses</div>
<div>Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,</div>
<div>Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,</div>
<div>CheckLst, excel97, ExcelXP, OleServer, ComObj, excel2000, mmsystem, ShellAPI,</div>
<div>ADODB, DB, DBGrids, clipbrd;</div>
<div> </div>
<div>Var</div>
<div>FExcel:OleVariant; //excel应用程序</div>
<div>FWorkBook :OleVariant; //工作表</div>
<div>Temsheet:OleVariant; //工作薄</div>
<div>FPicture:OleVariant;//图片</div>
<div>tmpstr:String;</div>
<div>range:variant;//范围</div>
<div>i,j,TemInt:integer;</div>
<div>TemFileName:String;</div>
<div>begin</div>
<div>SaveDialog1.Filter:='.xls';</div>
<div>if SaveDialog1.Execute then</div>
<div>begin</div>
<div>TemFileName:=SaveDialog1.FileName+'.xls';</div>
<div> </div>
<div>Screen.Cursor:=CrHourGlass;</div>
<div>TemInt:=0;</div>
<div>FExcel:= CreateoleObject('excel.Application');</div>
<div>FWorkBook:=FExcel.WorkBooks.Add(-4167); //新的工作表</div>
<div> </div>
<div> </div>
<div>Temsheet:=FWorkBook.Worksheets.Add;</div>
<div>Temsheet.Name:='利润统计';</div>
<div> </div>
<div>Temsheet.Select;</div>
<div>Temsheet.Columns.ColumnWidth:=4;//设置列宽度</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=16;</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=10;</div>
<div>Temsheet.Columns.ColumnWidth:=20;</div>
<div>Temsheet.Columns.ColumnWidth:=15;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge; //合并单元格</div>
<div> </div>
<div>tmpstr:=ExtractFilePath(ParamStr(0))+'tem.jpg'; //添加图片</div>
<div>FPicture:=Temsheet.Pictures.Insert(tmpstr);</div>
<div>FPicture.Left:=20;</div>
<div>FPicture.Top:=5;</div>
<div>FPicture.width:=50;</div>
<div>FPicture.height:=50;</div>
<div>FPicture:=null;</div>
<div> </div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells:=ComSName;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells:=ComEName;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells:=ComName;</div>
<div> </div>
<div>Temsheet.Cells:='联系人:';</div>
<div>Temsheet.Cells:='电话:';</div>
<div>Temsheet.Cells:=ComPhone;</div>
<div>Temsheet.Cells:='传真:';</div>
<div>Temsheet.Cells:=ComFax;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells:='入库信息:';</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>Temsheet.Cells:='序号';</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells.Interior.Color:=clGray; //单元格背景色</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div> </div>
<div> </div>
<div>for i:=0 to DBGrid1.Columns.Count - 1 do</div>
<div>begin</div>
<div>Temsheet.Cells:=DBGrid1.Columns.Title.Caption;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells.Interior.Color:=clGray; //单元格背景色</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div>end;</div>
<div> </div>
<div>//////////////////////////////////////////////</div>
<div>j:=0;</div>
<div>DBGrid1.DataSource.DataSet.First;</div>
<div>while not DBGrid1.DataSource.DataSet.Eof do</div>
<div>begin</div>
<div>Temsheet.Cells.Value:=j+1;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div> </div>
<div>for i:=0 to DBGrid1.Columns.Count - 1 do</div>
<div>begin</div>
<div>Temsheet.Cells.Value:=DBGrid1.Fields.AsString;</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div>end;</div>
<div>DBGrid1.DataSource.DataSet.Next;</div>
<div>j:=j+1;</div>
<div>end;</div>
<div> </div>
<div>TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells:='出库信息:';</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>Temsheet.Cells:='序号';</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells.Interior.Color:=clGray; //单元格背景色</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div> </div>
<div> </div>
<div>for i:=0 to DBGrid2.Columns.Count - 1 do</div>
<div>begin</div>
<div>Temsheet.Cells:=DBGrid2.Columns.Title.Caption;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>Temsheet.Cells.Interior.Color:=clGray; //单元格背景色</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div>end;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div>//////////////////////////////////////////////</div>
<div>j:=0;</div>
<div>DBGrid2.DataSource.DataSet.First;</div>
<div>while not DBGrid2.DataSource.DataSet.Eof do</div>
<div>begin</div>
<div>Temsheet.Cells.Value:=j+1;</div>
<div>Temsheet.Cells.HorizontalAlignment:=-4108; //字居中</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div> </div>
<div>for i:=0 to DBGrid2.Columns.Count - 1 do</div>
<div>begin</div>
<div>Temsheet.Cells.Value:=DBGrid2.Fields.AsString;</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div>end;</div>
<div>DBGrid2.DataSource.DataSet.Next;</div>
<div>j:=j+1;</div>
<div>end;</div>
<div> </div>
<div>TemInt:=TemInt+ DBGrid2.DataSource.DataSet.RecordCount;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells:='入库总额:';</div>
<div>Temsheet.Cells:=Trim(Edit1.Text);</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells:='出库总额:';</div>
<div>Temsheet.Cells:=Trim(Edit2.Text);</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>TemInt:=TemInt+1;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div>Range.Characters.Font.FontStyle :='加粗';</div>
<div>Temsheet.Cells:='总利润:';</div>
<div>Temsheet.Cells:=Trim(Edit3.Text);</div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.select;</div>
<div>range.merge;</div>
<div> </div>
<div>range:=Temsheet.Range,Temsheet.cells];//选定表格</div>
<div>range.borders.linestyle:=1;//华线</div>
<div> </div>
<div>Application.ProcessMessages;</div>
<div> </div>
<div>Screen.Cursor:=CrDefault;</div>
<div>FExcel.WorkBooks.saveas(TemFileName);//保存文件</div>
<div>FExcel.workbooks.close; //关闭工作表</div>
<div>Application.ProcessMessages;</div>
<div>MessageBox(Handle,'导出成功','提示',MB_OK);</div>
<div>//FExcel.visible:=true;</div>
<div>FExcel.quit; //关闭Excel</div>
<div>FExcel := unassigned;</div>
<div>shellexecute(0,'open',PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);</div>
<div> </div>
<div>end;</div>
<div>end;</div>
<div> </div>
<div>--------------------------------------------------------------------------------------------------------------------</div>
<div>********************************************************************************************************************</div>
<div>uses</div>
<div>Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,</div>
<div>Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,</div>
<div>CheckLst, excel97, ExcelXP, OleServer, comobj, excel2000, mmsystem,</div>
<div>ADODB, DB, DBGrids, clipbrd;</div>
<div> </div>
<div>四;</div>
<div>procedure TFIND_FM.Button1Click(Sender: TObject);</div>
<div>var</div>
<div>i,j : integer;</div>
<div>reportname, wpath : string;</div>
<div>ExApp1 : TExcelApplication;</div>
<div>ExWrbk1 : TExcelWorkbook;</div>
<div>ExWrst1 : TExcelWorksheet;</div>
<div>begin</div>
<div> </div>
<div>if Main_FM.ADOQuery_TEMP.IsEmpty then</div>
<div>begin</div>
<div>Showmessage('沒有可導出的資料!');</div>
<div>Exit;</div>
<div>end</div>
<div>else</div>
<div>begin</div>
<div>Main_FM.SaveDialog1.FileName := 'qcreport';</div>
<div>if Main_FM.savedialog1.Execute then</div>
<div>begin</div>
<div>//savedialog1.FileName := formatdatetime('YYYYMMDDHHMMSS',now())+'md_orderqc_list.xls';</div>
<div>reportname := formatdatetime('YYYYMMDDHHMMSS',now())+ExtractFileName(Main_FM.savedialog1.FileName);</div>
<div>//reportname := formatdatetime('YYYYMMDDHHMMSS',now())+'';</div>
<div>wpath := ExtractFilePath(Main_FM.savedialog1.FileName);</div>
<div>//showmessage(wpath);</div>
<div> </div>
<div>try</div>
<div>ExApp1 := TExcelApplication.Create(application);</div>
<div>ExWrbk1 := TExcelWorkbook.Create(application);</div>
<div>ExWrst1 := TExcelWorksheet.Create(application);</div>
<div>ExApp1.Connect;</div>
<div>except</div>
<div>Showmessage('電腦沒裝Excel!無法導出!');</div>
<div>Abort;</div>
<div>end;</div>
<div>try</div>
<div>try</div>
<div>ExApp1.Workbooks.Add(EmptyParam,0);</div>
<div>ExWrbk1.ConnectTo(ExApp1.Workbooks);</div>
<div>ExWrst1.ConnectTo(ExWrbk1.Worksheets as _worksheet);</div>
<div>Main_FM.ADOQuery_TEMP.First;</div>
<div>for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do</div>
<div>begin</div>
<div>ExWrst1.Cells.Item := Main_FM.ADOQuery_TEMP.Fields.DisplayName;</div>
<div>//</div>
<div>end;</div>
<div>for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 do</div>
<div>begin</div>
<div>for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do</div>
<div>begin</div>
<div>ExWrst1.Cells.Item := Main_FM.ADOQuery_TEMP.Fields.Value;</div>
<div>end;</div>
<div>Main_FM.ADOQuery_TEMP.Next;</div>
<div>end;</div>
<div>ExWrst1.SaveAs(wpath+reportname);</div>
<div>//ExWrst.SaveAs(formatdatetime('YYYYMMDDHHMMSS',now())+reportname);;</div>
<div>Showmessage('數據已成功導出!');</div>
<div>except</div>
<div>Showmessage('導出失敗!');</div>
<div>abort;</div>
<div>end;</div>
<div>finally</div>
<div>ExApp1.Disconnect;</div>
<div>ExApp1.Quit;</div>
<div>ExApp1.Free;</div>
<div>ExWrbk1.Free;</div>
<div>ExWrst1.Free;</div>
<div>end;</div>
<div>end;</div>
<div>end;</div>
<div>end;</div>
<div> </div>
<div> </div>
<div>--------------------------------------------------------------------------------------------------</div>
<div>**************************************************************************************************</div>
<div>delphi导出数据至Excel的三种方法及比较</div>
<div>闲来无事,跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差,以便比较。(本来使用Timer控件,但是Timer不适合做高精度时间计算)</div>
<div>使用TADOConnect,TADOQuery查询数据。</div>
<div>方法五:</div>
<div>使用TADOQuery + Varaint方法,循环遍历数据集中数据,直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。</div>
<div>在下面代码中没有仔细注意语法(比如没有使用try..finally结构体),如果需要使用,请注意:</div>
<div>//使用ADO循环方式保存</div>
<div>procedure TForm1.btn_WhileClick(Sender: TObject);</div>
<div>var</div>
<div>Eclapp:variant;</div>
<div>n:integer;</div>
<div>filename: string;</div>
<div>t1,t2: Int64;</div>
<div>begin</div>
<div>Eclapp := CreateOleObject('Excel.Application');</div>
<div>Eclapp.WorkBooks.Add;</div>
<div>Eclapp.Visible:= False;</div>
<div>filename :='d:\数据1.xls';</div>
<div>lbl2.Caption := '0';</div>
<div>if FileExists(fileName) then</div>
<div>DeleteFile(fileName);</div>
<div>t1:= GetTickCount;</div>
<div>qry1.DisableControls;</div>
<div>qry1.First;</div>
<div>n:=2;</div>
<div>while not qry1.Eof do</div>
<div>begin</div>
<div>eclapp.cells := qry1.Fields.AsString;</div>
<div>eclapp.cells := qry1.Fields.AsString;</div>
<div>eclapp.cells := qry1.Fields.AsString;</div>
<div>eclapp.cells := qry1.Fields.AsString;</div>
<div>//为了简单,只添加了4个栏位</div>
<div>inc(n);</div>
<div>qry1.Next;</div>
<div>application.ProcessMessages;</div>
<div>end;</div>
<div>qry1.EnableControls;</div>
<div>t2:= GetTickCount;</div>
<div>eclapp.visible := false;</div>
<div>eclapp.Workbooks.SaveAs(filename);</div>
<div>Eclapp.Quit;</div>
<div>Eclapp:= Unassigned;</div>
<div>lbl2.Caption := IntToStr(t2 - t1);</div>
<div>end;</div>
<div> </div>
<div> </div>
<div>---------------------------------------------------------------------------------------------------------</div>
<div>*********************************************************************************************************</div>
<div> </div>
<div>方法六:使用OLE方法导入。</div>
<div> </div>
<div>先讲TDateSet中的数据保存为二维OLEVariant数组中,再保存到Excel Sheet中 ///使用OLE方式保存procedure TForm1.btn_OleVariantClick(Sender: TObject);</div>
<div>var</div>
<div>fileName: string;</div>
<div>xlApp, Sheet: OleVariant;</div>
<div>rowCount, Colcount, index: Integer;</div>
<div>t1,t2: Int64;</div>
<div>function RefToCell(RowID, ColID: Integer): string;</div>
<div>var</div>
<div>ACount, APos: Integer;</div>
<div>begin</div>
<div>ACount := ColID div 26;</div>
<div>APos := ColID mod 26;</div>
<div>if APos = 0 then</div>
<div>begin</div>
<div>ACount := ACount - 1;</div>
<div>APos := 26;</div>
<div>end;</div>
<div>if ACount = 0 then</div>
<div>Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);</div>
<div>if ACount = 1 then</div>
<div>Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);</div>
<div>if ACount > 1 then</div>
<div>Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);</div>
<div>end;</div>
<div>function getData(ds: TDataSet): OleVariant;</div>
<div>var</div>
<div>Data: OLEVariant;</div>
<div>i,j : Integer;</div>
<div>begin</div>
<div>rowCount := ds.RecordCount;</div>
<div>colCount := ds.FieldCount;</div>
<div>Data := VarArrayCreate(, varVariant); //1,rowCount 表示第一维数组的上下标,1,colCount表示第二维数组的上下标</div>
<div>i := 1;</div>
<div>for j := 0 to colCount - 1 do</div>
<div>begin</div>
<div>if not ds.Fields.Visible then</div>
<div>continue;</div>
<div>Data := ds.Fields.DisplayLabel;</div>
<div>end;</div>
<div>Inc(i);</div>
<div>ds.DisableControls;</div>
<div>try</div>
<div>ds.First;</div>
<div>while not ds.Eof do</div>
<div>begin</div>
<div>for j := 0 to colCount - 1 do</div>
<div>begin</div>
<div>Data := ds.Fields.AsString;</div>
<div>end;</div>
<div>Inc(i);</div>
<div>ds.Next;</div>
<div>Application.ProcessMessages;</div>
<div>end;</div>
<div>finally</div>
<div>ds.EnableControls;</div>
<div>end;</div>
<div>result := Data;</div>
<div>end;</div>
<div>begin</div>
<div>fileName := 'd:\数据.xls';</div>
<div>lbl1.Caption := '0';</div>
<div>t1:= GetTickCount;//开始计时</div>
<div>if FileExists(fileName) then</div>
<div>DeleteFile(fileName);</div>
<div>xlApp := CreateOleObject('Excel.Application');</div>
<div>try</div>
<div>XLApp.Visible := False;</div>
<div>XLApp.DisplayAlerts := False;</div>
<div>XLApp.Workbooks.Add;</div>
<div>// 删除多余的 worksheet</div>
<div>for index := XLApp.SheetsInNewWorkbook downto 2 do</div>
<div>begin</div>
<div>XLApp.Workbooks.Worksheets.Delete;</div>
<div>end;</div>
<div>Sheet := XLApp.Workbooks.Worksheets;</div>
<div>index := 1;</div>
<div>if index <> 0 then</div>
<div>Sheet := XLApp.Workbooks.Worksheets.Add;</div>
<div>Sheet.Name := qry1.Name;</div>
<div>//Sheet.Columns.NumberFormatLocal := '@'; //设置单元格式为文本</div>
<div>Sheet.Range.Value := getData(qry1);</div>
<div>XLApp.Workbooks.SaveAs(fileName);</div>
<div>finally</div>
<div>if not VarIsEmpty(XLApp) then</div>
<div>begin</div>
<div>XLApp.Quit;</div>
<div>XLAPP := Unassigned;</div>
<div>Sheet := Unassigned;</div>
<div>application.ProcessMessages;</div>
<div>t2:= GetTickCount;</div>
<div>lbl1.Caption := IntToStr( t2 - t1);</div>
<div>end;</div>
<div>end;</div>
<div>end;</div>
<div> </div>
<div> </div>
<div>-------------------------------------------------------------------------------------------------------</div>
<div>*******************************************************************************************************</div>
<div> </div>
<div>方法七:现在最流行的文件流方法</div>
<div>.....</div>
<div>var</div>
<div>Form1: TForm1;</div>
<div>arXlsBegin: array of Word = ($809, 8, 0, $10, 0, 0);</div>
<div>arXlsEnd: array of Word = ($0A, 00);</div>
<div>arXlsString: array of Word = ($204, 0, 0, 0, 0, 0);</div>
<div>arXlsNumber: array of Word = ($203, 14, 0, 0, 0);</div>
<div>arXlsInteger: array of Word = ($27E, 10, 0, 0, 0);</div>
<div>arXlsBlank: array of Word = ($201, 6, 0, 0, $17);</div>
<div>Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);</div>
<div> </div>
<div>implementation</div>
<div>{$R *.dfm}</div>
<div>//使用文件流</div>
<div> </div>
<div>procedure incColRow; //增加行列号</div>
<div>begin</div>
<div>if Col = ADataSet.FieldCount - 1 then</div>
<div>begin</div>
<div>Inc(Row);</div>
<div>Col :=0;</div>
<div>end</div>
<div>else</div>
<div>Inc(Col);</div>
<div>end;</div>
<div> </div>
<div>procedure WriteStringCell(AValue: string);//写字符串数据</div>
<div>var</div>
<div>L: Word;</div>
<div>begin</div>
<div>L := Length(AValue);</div>
<div>arXlsString := 8 + L;</div>
<div>arXlsString := Row;</div>
<div>arXlsString := Col;</div>
<div>arXlsString := L;</div>
<div>aFileStream.WriteBuffer(arXlsString, SizeOf (arXlsString));</div>
<div>aFileStream.WriteBuffer(Pointer(AValue)^, L);</div>
<div>IncColRow;</div>
<div>end;</div>
<div> </div>
<div>procedure WriteIntegerCell(AValue: integer);//写整数</div>
<div>var</div>
<div>V: Integer;</div>
<div>begin</div>
<div>arXlsInteger := Row;</div>
<div>arXlsInteger := Col;</div>
<div>aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));</div>
<div>V := (AValue shl 2) or 2;</div>
<div>aFileStream.WriteBuffer(V, 4);</div>
<div>IncColRow;</div>
<div>end;</div>
<div> </div>
<div>procedure WriteFloatCell(AValue: double );//写浮点数</div>
<div>begin</div>
<div>arXlsNumber := Row;</div>
<div>arXlsNumber := Col;</div>
<div>aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));</div>
<div>aFileStream.WriteBuffer(AValue, 8);</div>
<div>IncColRow;</div>
<div>end;</div>
<div> </div>
<div>Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);</div>
<div>var</div>
<div>i,j: integer;</div>
<div>Col , row: word;</div>
<div>ABookMark: TBookMark;</div>
<div>aFileStream: TFileStream;</div>
<div>//......</div>
<div> </div>
<div>//......</div>
<div>begin</div>
<div>if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除</div>
<div>aFileStream := TFileStream.Create(FileName, fmCreate);</div>
<div>Try //写文件头 </div>
<div>aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); //写列头 </div>
<div>Col := 0; Row := 0;</div>
<div>if bWriteTitle then</div>
<div>begin</div>
<div>for i := 0 to aDataSet.FieldCount - 1 do</div>
<div>WriteStringCell(aDataSet.Fields.FieldName);</div>
<div>end; //写数据集中的数据 </div>
<div>aDataSet.DisableControls;</div>
<div>//ABookMark := aDataSet.GetBookmark;</div>
<div>aDataSet.First ;</div>
<div>while not aDataSet.Eof do</div>
<div>begin</div>
<div>for i := 0 to aDataSet.FieldCount - 1 do</div>
<div>case ADataSet.Fields.DataType of</div>
<div>ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:</div>
<div>WriteIntegerCell(aDataSet.Fields.AsInteger);</div>
<div>ftFloat, ftCurrency, ftBCD:</div>
<div>WriteFloatCell(aDataSet.Fields.AsFloat)</div>
<div>else</div>
<div>WriteStringCell(aDataSet.Fields.AsString);</div>
<div>end;</div>
<div>aDataSet.Next;</div>
<div>Application.ProcessMessages;</div>
<div>end;</div>
<div>//写文件尾 </div>
<div>AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));</div>
<div>//if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);</div>
<div>Finally</div>
<div>AFileStream.Free;</div>
<div>ADataSet.EnableControls;</div>
<div>end;</div>
<div>end;</div>
<div> </div>
<div>//调用:</div>
<div>procedure TForm1.btn_FileStreamClick(Sender: TObject);</div>
<div>var</div>
<div>t1,t2: Int64;</div>
<div>begin</div>
<div>lbl3.Caption := '0';</div>
<div>t1:= GetTickCount;</div>
<div>ExportExcelFile('d:\数据2.xls',true,qry1);</div>
<div>t2:= GetTickCount;</div>
<div>lbl3.Caption:= IntToStr(t2 - t1);</div>
<div>end;</div><br><br>
来源:https://www.cnblogs.com/yclizq/p/12093009.html
頁:
[1]