delphi到处EXCEL代码例子.doc

delphi dbgrid 导出Excel表 / 利用剪贴板，速度很快！适合装有Excel的机器/ USES Clipbrd,ComObj; procedure TForm1.Button1Click(Sender: TObject); var str:string; i:Integer; excelapp,sheet:Variant; begin / lbl2.Caption:=DateTimeToStr(Now); str:=; dbgrd1.DataSource.DataSet.DisableControls; for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do str:=str+dbgrd1.DataSource.DataSet.fieldsi.DisplayLabel+char(9); str:=str+#13; dbgrd1.DataSource.DataSet.First; while not(dbgrd1.DataSource.DataSet.eof) do begin for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do str:=str+dbgrd1.DataSource.DataSet.Fieldsi.AsString+char(9); str:=str+#13; dbgrd1.DataSource.DataSet.next; lbl1.Caption:=IntToStr(dbgrd1.DataSource.DataSet.RecNo); Application.ProcessMessages; end;/end while dbgrd1.DataSource.DataSet.EnableControls; clipboard.Clear; Clipboard.Open; Clipboard.AsText:=str; Clipboard.Close; excelapp:=createoleobject(excel.application); excelapp.workbooks.add(1); / excelapp.workbooks.add(-4167); sheet:=excelapp.workbooks1.worksheets1; :=sheet1; sheet.paste; Clipboard.Clear; / sheet.columns.font.Name:=宋体; / sheet.columns.font.size:=9; / sheet.Columns.AutoFit; excelapp.visible:=true; / lbl3.Caption:=DateTimeToStr(Now); end; /利用TStringList，速度很快！适合没有装Excel的机器/ procedure TForm1.Button1Click(Sender: TObject); var s:TStringList; str:string; i:Integer; begin / lbl1.Caption:=DateTimeToStr(Now); str:=; dbgrd1.DataSource.DataSet.DisableControls; for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do str:=str+dbgrd1.DataSource.DataSet.fieldsi.DisplayLabel+char(9); str:=str+#13; dbgrd1.DataSource.DataSet.First; while not(dbgrd1.DataSource.DataSet.eof) do begin for i:=0 to dbgrd1.DataSource.DataSet.FieldCount-1 do str:=str+dbgrd1.DataSource.DataSet.Fieldsi.AsString+char(9); str:=str+#13; dbgrd1.DataSource.DataSet.next; / lbl3.Caption:=IntToStr(dbgrd1.DataSource.DataSet.RecNo); / Application.ProcessMessages; end;/end while dbgrd1.DataSource.DataSet.EnableControls; s:=TStringList.Create; s.Add(str); s.SaveToFile(c:temp.xls);/保存到c:temp.xls s.Free; / lbl2.Caption:=DateTimeToStr(Now); end; /*(Delphi)Excel的快速导入*(Delphi)Excel的快速导入/怎样可以提高EXCEL的导出速度？uses ADODB,excel97,adoint;function TForm1.ExportToExcel: Boolean;varxlApp,xlBook,xlSheet,xlQuery: Variant;adoConnection,adoRecordset: Variant;beginadoConnection := CreateOleObject(ADODB.Connection);adoRecordset := CreateOleObject(ADODB.Recordset);adoConnection.Open(Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:Tree.mdb;Persist Security Info=False);adoRecordset.CursorLocation := adUseClient;adoRecordset.Open(SELECT * FROM tree,adoConnection,1,3);tryxlApp := CreateOleObject(Excel.Application);xlBook := xlApp.Workbooks.Add;xlSheet := xlBook.Worksheetssheet1;/设置这一列为 文本列 ，让 00123 正确显示， 而不是自动转换为123xlSheet.ColumnsC:C.NumberFormatLocal := ;xlApp.Visible := True;/把查询结果导入EXCEL数据xlQuery := xlSheet.QueryTables.Add(adoRecordset,xlSheet.RangeA1); /关键是这一句xlQuery.FieldNames := True;xlQuery.RowNumbers := False;xlQuery.FillAdjacentFormulas := False;xlQuery.PreserveFormatting := True;xlQuery.RefreshOnFileOpen := False;xlQuery.BackgroundQuery := True;/xlQuery.RefreshStyle := xlInsertDeleteCells;xlQuery.SavePassword := True;xlQuery.SaveData := True;xlQuery.AdjustColumnWidth := True;xlQuery.RefreshPeriod := 0;xlQuery.PreserveColumnInfo := True;xlQuery.FieldNames := True;xlQuery.Refresh;xlBook.SaveAs(d:fromD.xls,xlNormal,False,False);finallyif not VarIsEmpty(XLApp) then beginXLApp.displayAlerts:=false;XLApp.ScreenUpdating:=true;XLApp.quit;end;end;end;/procedure saveToExcel();varEclapp,workbook:variant;i,n:integer;beginif not adoquery1.Active then exit;if adoquery1.RecordCount=0 then exit;if application.MessageBox(确认导出excel表吗？,提示,mb_okcancel+mb_iconinformation)=idcancel then exit;Eclapp := createoleobject(Excel.Application);Eclapp.workbooks.add;for i:=0 to dbgrid2.FieldCount-1 dobeginEclapp.cells1,i+1:=dbgrid2.Columnsi.Title.Caption;end;Eclapp.cells1,5:=签字;adoquery1.First;n:=2;while not adoquery1.Eof dobegineclapp.cellsn,1 := adoquery1.Fields0.AsString;eclapp.cellsn,2 := adoquery1.Fields1.AsString;eclapp.cellsn,3 := adoquery1.Fields2.AsString;eclapp.cellsn,4 := adoquery1.Fields4.AsString;eclapp.cellsn,6 := ;inc(n);adoquery1.Next;end;eclapp.cellsn,1 := 满足条件记录的总数为：+inttostr(adoquery1.RecordCount)+条;application.MessageBox(数据导出完成!,提示,mb_ok+mb_iconinformation);eclapp.visible := true;end;方法二procedure CopyDbDataToExcel(Args: array of const); var iCount, jCount: Integer; XLApp: Variant; Sheet,range: Variant; I: Integer; begin Screen.Cursor := crHourGlass; if not VarIsEmpty(XLApp) then begin XLApp.DisplayAlerts := False; XLApp.Quit; VarClear(XLApp); end;try XLApp:=CreateOleObject(Excel.Application); except Screen.Cursor := crDefault; Exit; end;XLApp.WorkBooks.Add; XLApp.SheetsInNewWorkbook := High(Args) + 1;for I := Low(Args) to High(Args) do begin XLApp.WorkBooks1.WorkSheetsI+1.Name := TDBGrid(ArgsI.VObject).Name; Sheet := XLApp.Workbooks1.WorkSheetsTDBGrid(ArgsI.VObject).Name;if not TDBGrid(ArgsI.VObject).DataSource.DataSet.Active then begin Screen.Cursor := crDefault; Exit; end; TDBGrid(ArgsI.VObject).DataSource.DataSet.first; for iCount := 0 to TDBGrid(ArgsI.VObject).Columns.Count - 1 do range:=sheet.rangesheet.cells1,1,sheet.cells1,iCount + 1; range.select; range.merge; sheet.cells1,1:=+fqueryhuman.dbedit2.text+个人报销记录（普通报销、特殊报销）查询; jCount :=2; for iCount := 0 to TDBGrid(ArgsI.VObject).Columns.Count - 1 do Sheet.Cells2, iCount + 1:=TDBGrid(ArgsI.VObject).Columns.ItemsiCount.Title.Caption; while not TDBGrid(ArgsI.VObject).DataSource.DataSet.Eof do begin for iCount := 0 to TDBGrid(ArgsI.VObject).Columns.Count - 1 do Sheet.CellsjCount + 1, iCount + 1 := TDBGrid(ArgsI.VObject).Columns.ItemsiCount.Field.AsString;Inc(jCount); TDBGrid(ArgsI.VObject).DataSource.DataSet.Next; end; XlApp.Visible := True; end; Screen.Cursor := crDefault; end;方法三delphi导入/导出excel2008年03月02日 星期日 16:39从Excel文件中,导入数据到SQL数据库中,很简单,直接用下面的语句:-如果接受数据导入的表已经存在insert into 表 select * fromOPENROWSET(MICROSOFT.JET.OLEDB.4.0,Excel 5.0;HDR=YES;DATABASE=c:test.xls,sheet1$)-如果导入数据并生成表select * into 表 fromOPENROWSET(MICROSOFT.JET.OLEDB.4.0,Excel 5.0;HDR=YES;DATABASE=c:test.xls,sheet1$)-如果从SQL数据库中,导出数据到Excel,如果Excel文件已经存在,而且已经按照要接收的数据创建好表头,就可以简单的用:insert into OPENROWSET(MICROSOFT.JET.OLEDB.4.0,Excel 5.0;HDR=YES;DATABASE=c:test.xls,sheet1$)select * from 表-如果Excel文件不存在,也可以用BCP来导成类Excel的文件,注意大小写:-导出表的情况EXEC master.xp_cmdshell bcp 数据库名.dbo.表名 out c:test.xls /c -/S服务器名 /U用户名 -P密码-导出查询的情况EXEC master.xp_cmdshell bcp SELECT au_fname, au_lname FROM pubs.authors ORDER BY au_lname queryout c:test.xls /c -/S服务器名 /U用户名 -P密码-下面是导出真正Excel文件的方法:if exists (select * from dbo.sysobjects where id = object_id(Ndbo.p_exporttb) and OBJECTPROPERTY(id, NIsProcedure) = 1)drop procedure dbo.p_exporttbGOcreate proc p_exporttbtbname sysname, -要导出的表名path nvarchar(1000), -文件存放目录fname nvarchar(250)= -文件名,默认为表名asdeclare err int,src nvarchar(255),desc nvarchar(255),out intdeclare obj int,constr nvarchar(1000),sql varchar(8000),fdlist varchar(8000)-参数检测if isnull(fname,)= set fname=tbname+.xls-检查文件是否已经存在if right(path,1) set path=path+create table #tb(a bit,b bit,c bit)set sql=path+fnameinsert into #tb exec master.xp_fileexist sql-数据库创建语句set sql=path+fnameif exists(select 1 from #tb where a=1)set constr=DRIVER=Microsoft Excel Driver (*.xls);DSN=;READONLY=FALSE+;CREATE_DB=+sql+;DBQ=+sqlelseset constr=Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;HDR=YES+;DATABASE=+sql+-连接数据库exec err=sp_oacreate adodb.connection,obj outif err0 goto lberrexec err=sp_oamethod obj,open,null,constrif err0 goto lberr-创建表的SQLselect sql=,fdlist=select fdlist=fdlist+,++,sql=sql+,++ +casewhen like %charthen case when a.length255 then memoelse text(+cast(a.length as varchar)+) endwhen like %int or =bit then intwhen like %datetime then datetimewhen like %money then moneywhen like %text then memoelse endFROM syscolumns a left join systypes b on a.xtype=b.xusertypewhere not in(image,uniqueidentifier,sql_variant,varbinary,binary,timestamp)and object_id(tbname)=idselect sql=create table +tbname+(+substring(sql,2,8000)+),fdlist=substring(fdlist,2,8000)exec err=sp_oamethod obj,execute,out out,sqlif err0 goto lberrexec err=sp_oadestroy obj-导入数据set sql=openrowset(MICROSOFT.JET.OLEDB.4.0,Excel 8.0;HDR=YES;IMEX=1;DATABASE=+path+fname+,+tbname+$)exec(insert into +sql+(+fdlist+) select +fdlist+ from +tbname)returnlberr:exec sp_oageterrorinfo 0,src out,desc outlbexit:select cast(err as varbinary(4) as 错误号,src as 错误源,desc as 错误描述select sql,constr,fdlistgoif exists (select * from dbo.sysobjects where id = object_id(Ndbo.p_exporttb) and OBJECTPROPERTY(id, NIsProcedure) = 1)drop procedure dbo.p_exporttbGOcreate proc p_exporttbsqlstr varchar(8000), -查询语句,如果查询语句中使用了order by ,请加上top 100 percentpath nvarchar(1000), -文件存放目录fname nvarchar(250), -文件名sheetname varchar(250)= -要创建的工作表名,默认为文件名asdeclare err int,src nvarchar(255),desc nvarchar(255),out intdeclare obj int,constr nvarchar(1000),sql varchar(8000),fdlist varchar(8000)-参数检测if isnull(fname,)= set fname=temp.xlsif isnull(sheetname,)= set sheetname=replace(fname,.,#)-检查文件是否已经存在if right(path,1) set path=path+create table #tb(a bit,b bit,c bit)set sql=path+fnameinsert into #tb exec master.xp_fileexist sql-数据库创建语句set sql=path+fnameif exists(select 1 from #tb where a=1)set constr=DRIVER=Microsoft Excel Driver (*.xls);DSN=;READONLY=FALSE+;CREATE_DB=+sql+;DBQ=+sqlelseset constr=Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;HDR=YES+;DATABASE=+sql+-连接数据库exec err=sp_oacreate adodb.connection,obj outif err0 goto lberrexec err=sp_oamethod obj,open,null,constrif err0 goto lberr-创建表的SQLdeclare tbname sysnameset tbname=#tmp_+convert(varchar(38),newid()set sql=select * into +tbname+ from(+sqlstr+) aexec(sql)select sql=,fdlist