如何将delphi的dbgrid导出为excel表.docx
《如何将delphi的dbgrid导出为excel表.docx》由会员分享，可在线阅读，更多相关《如何将delphi的dbgrid导出为excel表.docx（17页珍藏版）》请在冰豆网上搜索。
如何将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:
='';
ifthen
begin
ifapplication.messagebox（'需要导出的数据过大，Excel最
大只能容纳65536行,是否还要继续？
','询问',mb_yesno+mb_iconquestion）=idno
then
exit;
end;
screen.Cursor:
=crHourGlass;
try
excel:
=CreateOleObject（'Excel.Application'）;
;
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:
=0todo
begin
ifthen
begin
//Excel.Columns
[k+1].ColumnWidth:
=;
excel.cells[1,k+1]:
=
[i].Title.Caption;
inc（k）;
end;
end;
;
saveplace:
=;
;
i:
=2;
ifthen
ProgressBar1:
=ProgressBarform（65536）
else
ProgressBar1:
=ProgressBarform
（;
whilenotdo
begin
k:
=0;
forj:
=0todo
begin
ifthen
begin
excel.cells[i,k+1].NumberFormat:
='@';
ifnot
[j].FieldName）.isnullthen
begin
str:
=
[j].FieldName）.value;
Excel.Cells[i,k+1]:
=
Str;
end;
inc（k）;
end
else
continue;
end;
ifi=65536then
break;
inc（i）;
ProgressBar1.StepBy
（1）;
;
end;
;
application.ProcessMessages;
;
;
try
ifcopy（FileName,length（FileName）-3,4）<>'.xls'then
FileName:
=FileName+'.xls';
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:
='';
ifthen
begin
ifapplication.messagebox（'需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？
','询问',mb_yesno+mb_iconquestion）=idnothen
exit;
end;
screen.Cursor:
=crHourGlass;
try
excel:
=CreateOleObject（'Excel.Application'）;
;
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:
=0todo
begin
ifthen
begin
//Excel.Columns[k+1].ColumnWidth:
=;
excel.cells[1,k+1]:
=;
inc（k）;
end;
end;
;
saveplace:
=;
;
i:
=2;
ifthen
ProgressBar1:
=ProgressBarform（65536）
else
ProgressBar1:
=ProgressBarform（;
whilenotdo
begin
k:
=0;
forj:
=0todo
begin
ifthen
begin
excel.cells[i,k+1].NumberFormat:
='@';
ifnotthen
begin
str:
=;
Excel.Cells[i,k+1]:
=Str;
end;
inc（k）;
end
else
continue;
end;
ifi=65536then
break;
inc（i）;
ProgressBar1.StepBy
（1）;
;
end;
;
application.ProcessMessages;
;
;
try
ifcopy（FileName,length（FileName）-3,4）<>'.xls'then
FileName:
=FileName+'.xls';
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'）;
;
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;
inc（i）;
ProgressBar1.StepBy
（1）;
queryexport.next;
end;
;
application.ProcessMessages;
try
ifcopy（FileName,length（FileName）-3,4）<>'.xls'then
FileName:
=FileName+'.xls';
xlNormal,'','',False,False）;
except
Excel.Quit;
screen.cursor:
=crDefault;
exit;
end;
//Excel.Visible:
=true;
Excel.Quit;
screen.cursor:
=crDefault;
Result:
=true;
end;
end.
升级会员 