经常看到有人问如何把delphi中的数据集导入excel中,这里提供了一个实现。
在做项目时,很多情况下,客户需要对程序中数据集再加工,再利用,如报表。
这时,就需要把dataset导入到一个客户比较熟悉的格式中去。excel是首选了。该程序在delphi4,5下编译通过,已被用在多个项目中。还被集成在笔者所写的一个小组件tdbnavigatebutton中 {-------------------------------------------------------------------------------------------------
单元:uexceltools
作者: bear
功能:保存数据集,如ttable,tquery,tclientdataset等为excel文件,
包含标题,可以只将一部分字段导出
这一点通过设置dataset中要不导出字段的tag值大于某一个值来处理
原理:调用 microsoft excel ole对象
调用方式:
function datasettoexcel(
dataset:tdataset;fieldtagmax:integer;
visible:boolean;excelfilename:string=''): boolean;
--------------------------------------------------------------------------------------------------}unit uexceltools;interfaceuses
classes, comctrls, stdctrls, windows, dialogs, controls, sysutils,
db,forms,dbclient,comobj;//把数据集导入excelsheet的核心函数
function datasettoexcelsheet
(
dataset :tdataset;
fieldtagmax :integer; // 字段的tag值如果大于这个值,就不导出到excel
sheet :olevariant
): boolean;//实际使用的函数,内部调用了datasettoexcelsheet,在外面加入ui接口和错误处理
function datasettoexcel
(
dataset :tdataset; // 要转换的数据集
fieldtagmax :integer; // 字段的tag值如果大于这个值,就不导出到excel
visible :boolean; // 是否让做转换工作的excel可见
excelfilename:string='' // excel文件名,*.xls
): boolean;implementationfunction datasettoexcelsheet(dataset:tdataset;fieldtagmax:integer;sheet:olevariant): boolean;
var
row,col,fieldindex :integer;
bk:tbook;
begin
result := false;
if not dataset.active then exit;
bk:=dataset.getbook;
dataset.disablecontrols; sheet.activate;
try // 列标题
row:=1;
col:=1;
for fieldindex:=0 to dataset.fieldcount-1 do
begin
if dataset.fields[fieldindex].tag <= fieldtagmax then
begin
sheet.cells(row,col) :=dataset.fields[fieldindex].displaylabel;
inc(col);
end;
end;
// 表内容
dataset.first;
while not dataset.eof do
begin
row:=row+1;
col:=1;
for fieldindex:=0 to dataset.fieldcount-1 do
begin
if dataset.fields[fieldindex].tag <= fieldtagmax then
begin
sheet.cells(row,col):=dataset.fields[fieldindex].asstring;
inc(col);
end;
end;
dataset.next;
end; result := true;
finally
dataset.gotobook(bk);
dataset.enablecontrols;
end;
end;
function datasettoexcel(
dataset:tdataset;fieldtagmax:integer;
visible:boolean;excelfilename:string=''): boolean;
var
excelobj, excel, workbook, sheet: olevariant;
oldcursor:tcursor;
savedialog:tsavedialog;
begin
result := false;
if not dataset.active then exit; oldcursor:=screen.cursor;
screen.cursor:=crhourglass; try
excelobj := createoleobject('excel.sheet');
excel := excelobj.application;
excel.visible := visible ;
workbook := excel.workbooks.add ;
sheet:= workbook.sheets[1];
except
messagebox(getactivewindow,'无法调用mircorsoft excel! '+chr(13)+chr(10)+
'请检查是否安装了mircorsoft excel。','提示',mb_ok+mb_iconinformation);
screen.cursor:=oldcursor;
exit;
end; result:=datasettoexcelsheet(dataset,fieldtagmax,sheet) ;
if result then
if not visible then
begin
if excelfilename<>''
then workbook.saveas(filename:=excelfilename)
else begin
savedialog:=tsavedialog.create(nil);
savedialog.filter := 'microsoft excel 文件|*.xls';
result:=savedialog.execute;
updatewindow(getactivewindow);
if result then
workbook.saveas(filename:=savedialog.filename);
savedialog.free;
end;
excel.quit;
end;
screen.cursor:=oldcursor;
end; end.
在做项目时,很多情况下,客户需要对程序中数据集再加工,再利用,如报表。
这时,就需要把dataset导入到一个客户比较熟悉的格式中去。excel是首选了。该程序在delphi4,5下编译通过,已被用在多个项目中。还被集成在笔者所写的一个小组件tdbnavigatebutton中 {-------------------------------------------------------------------------------------------------
单元:uexceltools
作者: bear
功能:保存数据集,如ttable,tquery,tclientdataset等为excel文件,
包含标题,可以只将一部分字段导出
这一点通过设置dataset中要不导出字段的tag值大于某一个值来处理
原理:调用 microsoft excel ole对象
调用方式:
function datasettoexcel(
dataset:tdataset;fieldtagmax:integer;
visible:boolean;excelfilename:string=''): boolean;
--------------------------------------------------------------------------------------------------}unit uexceltools;interfaceuses
classes, comctrls, stdctrls, windows, dialogs, controls, sysutils,
db,forms,dbclient,comobj;//把数据集导入excelsheet的核心函数
function datasettoexcelsheet
(
dataset :tdataset;
fieldtagmax :integer; // 字段的tag值如果大于这个值,就不导出到excel
sheet :olevariant
): boolean;//实际使用的函数,内部调用了datasettoexcelsheet,在外面加入ui接口和错误处理
function datasettoexcel
(
dataset :tdataset; // 要转换的数据集
fieldtagmax :integer; // 字段的tag值如果大于这个值,就不导出到excel
visible :boolean; // 是否让做转换工作的excel可见
excelfilename:string='' // excel文件名,*.xls
): boolean;implementationfunction datasettoexcelsheet(dataset:tdataset;fieldtagmax:integer;sheet:olevariant): boolean;
var
row,col,fieldindex :integer;
bk:tbook;
begin
result := false;
if not dataset.active then exit;
bk:=dataset.getbook;
dataset.disablecontrols; sheet.activate;
try // 列标题
row:=1;
col:=1;
for fieldindex:=0 to dataset.fieldcount-1 do
begin
if dataset.fields[fieldindex].tag <= fieldtagmax then
begin
sheet.cells(row,col) :=dataset.fields[fieldindex].displaylabel;
inc(col);
end;
end;
// 表内容
dataset.first;
while not dataset.eof do
begin
row:=row+1;
col:=1;
for fieldindex:=0 to dataset.fieldcount-1 do
begin
if dataset.fields[fieldindex].tag <= fieldtagmax then
begin
sheet.cells(row,col):=dataset.fields[fieldindex].asstring;
inc(col);
end;
end;
dataset.next;
end; result := true;
finally
dataset.gotobook(bk);
dataset.enablecontrols;
end;
end;
function datasettoexcel(
dataset:tdataset;fieldtagmax:integer;
visible:boolean;excelfilename:string=''): boolean;
var
excelobj, excel, workbook, sheet: olevariant;
oldcursor:tcursor;
savedialog:tsavedialog;
begin
result := false;
if not dataset.active then exit; oldcursor:=screen.cursor;
screen.cursor:=crhourglass; try
excelobj := createoleobject('excel.sheet');
excel := excelobj.application;
excel.visible := visible ;
workbook := excel.workbooks.add ;
sheet:= workbook.sheets[1];
except
messagebox(getactivewindow,'无法调用mircorsoft excel! '+chr(13)+chr(10)+
'请检查是否安装了mircorsoft excel。','提示',mb_ok+mb_iconinformation);
screen.cursor:=oldcursor;
exit;
end; result:=datasettoexcelsheet(dataset,fieldtagmax,sheet) ;
if result then
if not visible then
begin
if excelfilename<>''
then workbook.saveas(filename:=excelfilename)
else begin
savedialog:=tsavedialog.create(nil);
savedialog.filter := 'microsoft excel 文件|*.xls';
result:=savedialog.execute;
updatewindow(getactivewindow);
if result then
workbook.saveas(filename:=savedialog.filename);
savedialog.free;
end;
excel.quit;
end;
screen.cursor:=oldcursor;
end; end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货