如何将delphi的dbgrid导出为excel表.docx

上传人:b****7 文档编号:9973554 上传时间:2023-02-07 格式:DOCX 页数:18 大小:16.39KB
下载 相关 举报
如何将delphi的dbgrid导出为excel表.docx_第1页
第1页 / 共18页
如何将delphi的dbgrid导出为excel表.docx_第2页
第2页 / 共18页
如何将delphi的dbgrid导出为excel表.docx_第3页
第3页 / 共18页
如何将delphi的dbgrid导出为excel表.docx_第4页
第4页 / 共18页
如何将delphi的dbgrid导出为excel表.docx_第5页
第5页 / 共18页
点击查看更多>>
下载资源
资源描述

如何将delphi的dbgrid导出为excel表.docx

《如何将delphi的dbgrid导出为excel表.docx》由会员分享,可在线阅读,更多相关《如何将delphi的dbgrid导出为excel表.docx(18页珍藏版)》请在冰豆网上搜索。

如何将delphi的dbgrid导出为excel表.docx

如何将delphi的dbgrid导出为excel表

unitunit2;

interface

uses

forms,SysUtils,ComCtrls,DBGrids,DB,Dialogs,Messages,Windows,ComObj,Cont

rols,ADODB,StdCtrls,Graphics;

functionProgressBarform(max:

integer):

tProgressBar;

functionExportToExcel(dbgrid:

tdbgrid):

boolean;

implementation

usesunit1;

//生成一个显示进度条的窗体

functionProgressBarform(max:

integer):

tProgressBar;

var

ProgressBar1:

TProgressBar;

form:

tform;

begin

application.CreateForm(tform,form);

form.Position:

=poScreenCenter;

form.BorderStyle:

=bsnone;

form.Height:

=30;

form.Width:

=260;

ProgressBar1:

=TProgressBar.Create(form);

ProgressBar1.Visible:

=true;

ProgressBar1.Smooth:

=true;

ProgressBar1.Max:

=max;

ProgressBar1.ParentWindow:

=form.Handle;

ProgressBar1.Height:

=20;

ProgressBar1.Width:

=250;

ProgressBar1.Left:

=form.Left+5;

ProgressBar1.Top:

=form.Top+5;

ProgressBar1.Step:

=1;

form.show;

result:

=ProgressBar1;

end;

//将DBGRID中的内容导入到EXCEL中

functionExportToExcel(dbgrid:

tdbgrid):

boolean;

const

xlNormal=-4143;

var

i,j,k:

integer;

str,filename:

string;

excel:

OleVariant;

SavePlace:

TBookmark;

savedialog:

tsavedialog;

ProgressBar1:

TProgressBar;

begin

result:

=false;

filename:

='';

ifdbgrid.DataSource.DataSet.RecordCount>65536then

begin

ifapplication.messagebox('需要导出的数据过大,Excel最

大只能容纳65536行,是否还要继续?

','询问',mb_yesno+mb_iconquestion)=idno

then

exit;

end;

screen.Cursor:

=crHourGlass;

try

excel:

=CreateOleObject('Excel.Application');

excel.workbooks.add;

except

screen.cursor:

=crDefault;

showmessage('无法调用Excel!

');

exit;

end;

savedialog:

=tsavedialog.Create(nil);

savedialog.Filter:

='Excel文件(*.xls)|*.xls';

ifsavedialog.Executethen

begin

ifFileExists(savedialog.FileName)then

try

ifapplication.messagebox('该文件已经存在

,要覆盖吗?

','询问',mb_yesno+mb_iconquestion)=idyesthen

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;

application.ProcessMessages;

iffilename=''then

begin

result:

=false;

Excel.Quit;

screen.cursor:

=crDefault;

exit;

end;

k:

=0;

fori:

=0todbgrid.Columns.count-1do

begin

ifdbgrid.Columns.Items[i].Visiblethen

begin

//Excel.Columns

[k+1].ColumnWidth:

=dbgrid.Columns.Items[i].Title.Column.Width;

excel.cells[1,k+1]:

=dbgrid.Columns.Items

[i].Title.Caption;

inc(k);

end;

end;

dbgrid.DataSource.DataSet.DisableControls;

saveplace:

=dbgrid.DataSource.DataSet.GetBookmark;

dbgrid.DataSource.dataset.First;

i:

=2;

ifdbgrid.DataSource.DataSet.recordcount>65536then

ProgressBar1:

=ProgressBarform(65536)

else

ProgressBar1:

=ProgressBarform

(dbgrid.DataSource.DataSet.recordcount);

whilenotdbgrid.DataSource.dataset.Eofdo

begin

k:

=0;

forj:

=0todbgrid.Columns.count-1do

begin

ifdbgrid.Columns.Items[j].Visiblethen

begin

excel.cells[i,k+1].NumberFormat:

='@';

ifnot

dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items

[j].FieldName).isnullthen

begin

str:

=

dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items

[j].FieldName).value;

Excel.Cells[i,k+1]:

=

Str;

end;

inc(k);

end

else

continue;

end;

ifi=65536then

break;

inc(i);

ProgressBar1.StepBy

(1);

dbgrid.DataSource.dataset.next;

end;

progressbar1.Owner.Free;

application.ProcessMessages;

dbgrid.DataSource.dataset.GotoBookmark(SavePlace);

dbgrid.DataSource.dataset.EnableControls;

try

ifcopy(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:

=true;

Excel.Quit;

screen.cursor:

=crDefault;

Result:

=true;

end;

end.

引用是直接引用该函数就可以了

ExportToExcel(dbgrid1)

以下是原文

含ado连接方式的函数,一般我们都用DBGRID中的内容导入到EXCEL中

unitU_func;

interface

usesforms,SysUtils,ComCtrls,DBGrids,DB,Dialogs,Messages,Windows,ComObj,Controls,ADODB,StdCtrls,Graphics;

functionProgressBarform(max:

integer):

tProgressBar;

functionExportToExcel(dbgrid:

tdbgrid):

boolean;

functionqueryExportToExcel(queryexport:

tadoquery):

boolean;

implementation

//生成一个显示进度条的窗体

functionProgressBarform(max:

integer):

tProgressBar;

var

ProgressBar1:

TProgressBar;

form:

tform;

begin

application.CreateForm(tform,form);

form.Position:

=poScreenCenter;

form.BorderStyle:

=bsnone;

form.Height:

=30;

form.Width:

=260;

ProgressBar1:

=TProgressBar.Create(form);

ProgressBar1.Visible:

=true;

ProgressBar1.Smooth:

=true;

ProgressBar1.Max:

=max;

ProgressBar1.ParentWindow:

=form.Handle;

ProgressBar1.Height:

=20;

ProgressBar1.Width:

=250;

ProgressBar1.Left:

=form.Left+5;

ProgressBar1.Top:

=form.Top+5;

ProgressBar1.Step:

=1;

form.show;

result:

=ProgressBar1;

end;

//将DBGRID中的内容导入到EXCEL中

functionExportToExcel(dbgrid:

tdbgrid):

boolean;

const

xlNormal=-4143;

var

i,j,k:

integer;

str,filename:

string;

excel:

OleVariant;

SavePlace:

TBookmark;

savedialog:

tsavedialog;

ProgressBar1:

TProgressBar;

begin

result:

=false;

filename:

='';

ifdbgrid.DataSource.DataSet.RecordCount>65536then

begin

ifapplication.messagebox('需要导出的数据过大,Excel最大只能容纳65536行,是否还要继续?

','询问',mb_yesno+mb_iconquestion)=idnothen

exit;

end;

screen.Cursor:

=crHourGlass;

try

excel:

=CreateOleObject('Excel.Application');

excel.workbooks.add;

except

screen.cursor:

=crDefault;

showmessage('无法调用Excel!

');

exit;

end;

savedialog:

=tsavedialog.Create(nil);

savedialog.Filter:

='Excel文件(*.xls)|*.xls';

ifsavedialog.Executethen

begin

ifFileExists(savedialog.FileName)then

try

ifapplication.messagebox('该文件已经存在,要覆盖吗?

','询问',mb_yesno+mb_iconquestion)=idyesthen

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;

application.ProcessMessages;

iffilename=''then

begin

result:

=false;

Excel.Quit;

screen.cursor:

=crDefault;

exit;

end;

k:

=0;

fori:

=0todbgrid.Columns.count-1do

begin

ifdbgrid.Columns.Items[i].Visiblethen

begin

//Excel.Columns[k+1].ColumnWidth:

=dbgrid.Columns.Items[i].Title.Column.Width;

excel.cells[1,k+1]:

=dbgrid.Columns.Items[i].Title.Caption;

inc(k);

end;

end;

dbgrid.DataSource.DataSet.DisableControls;

saveplace:

=dbgrid.DataSource.DataSet.GetBookmark;

dbgrid.DataSource.dataset.First;

i:

=2;

ifdbgrid.DataSource.DataSet.recordcount>65536then

ProgressBar1:

=ProgressBarform(65536)

else

ProgressBar1:

=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);

whilenotdbgrid.DataSource.dataset.Eofdo

begin

k:

=0;

forj:

=0todbgrid.Columns.count-1do

begin

ifdbgrid.Columns.Items[j].Visiblethen

begin

excel.cells[i,k+1].NumberFormat:

='@';

ifnotdbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnullthen

begin

str:

=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;

Excel.Cells[i,k+1]:

=Str;

end;

inc(k);

end

else

continue;

end;

ifi=65536then

break;

inc(i);

ProgressBar1.StepBy

(1);

dbgrid.DataSource.dataset.next;

end;

progressbar1.Owner.Free;

application.ProcessMessages;

dbgrid.DataSource.dataset.GotoBookmark(SavePlace);

dbgrid.DataSource.dataset.EnableControls;

try

ifcopy(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:

=true;

Excel.Quit;

screen.cursor:

=crDefault;

Result:

=true;

end;

//将ADOQUERY的数据集导入到EXCEL中

functionqueryExportToExcel(queryexport:

tadoquery):

boolean;

const

xlNormal=-4143;

var

i,j,k:

integer;

str,filename:

string;

excel:

OleVariant;

savedialog:

tsavedialog;

ProgressBar1:

TProgressBar;

begin

result:

=false;

filename:

='';

ifqueryexport.RecordCount>65536then

begin

ifapplication.messagebox('需要导出的数据过大,Excel最大只能容纳65536行,是否还要继续?

','询问',mb_yesno+mb_iconquestion)=idnothen

exit;

end;

screen.Cursor:

=crHourGlass;

try

excel:

=CreateOleObject('Excel.Application');

excel.workbooks.add;

except

screen.cursor:

=crDefault;

showmessage('无法调用Excel!

');

exit;

end;

savedialog:

=tsavedialog.Create(nil);

savedialog.Filter:

='Excel文件(*.xls)|*.xls';

ifsavedialog.Executethen

begin

ifFileExists(savedialog.FileName)then

try

ifapplication.messagebox('该文件已经存在,要覆盖吗?

','询问',mb_yesno+mb_iconquestion)=idyesthen

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;

application.ProcessMessages;

iffilename=''then

begin

result:

=false;

Excel.Quit;

screen.cursor:

=crDefault;

exit;

end;

k:

=0;

fori:

=0toqueryexport.FieldCount-1do

begin

excel.cells[1,k+1]:

=queryexport.Fields[i].FieldName;

inc(k);

end;

queryexport.First;

i:

=2;

ifqueryexport.recordcount>65536then

ProgressBar1:

=ProgressBarform(65536)

else

ProgressBar1:

=ProgressBarform(queryexport.recordcount);

whilenotqueryexport.Eofdo

begin

k:

=0;

forj:

=0toqueryexport.FieldCount-1do

begin

excel.cells[i,k+1].NumberFormat:

='@';

ifnotqueryexport.fieldbyname(queryexport.Fields[j].FieldName).isnullthen

begin

str:

=queryexport.fieldbyname(queryexport.Fields[j].FieldName).AsString;

Excel.Cells[i,k+1]:

=Str;

end;

inc(k);

end;

ifi=65536then

break;

in

展开阅读全文
相关资源
猜你喜欢
相关搜索

当前位置:首页 > PPT模板 > 动物植物

copyright@ 2008-2022 冰豆网网站版权所有

经营许可证编号:鄂ICP备2022015515号-1