导航
  • 主页
  • 招聘
  • 语言基础/算法/系统设计
  • 数据库相关
  • 图形处理/多媒体
  • 网络通信/分布式开发
  • VCL组件开发及应用
  • Windows SDK/API
  • 问答

[分享]将dataset导出EXCEL的function

stiwin 2002-10-07 08:54:06
procedure TFrmMain.WriteExcel(AdsData: TADODataSet; sName, Title: string);
var
ExcelApplication1: TExcelApplication;
ExcelWorksheet1: TExcelWorksheet;
ExcelWorkbook1: TExcelWorkbook;
i, j: integer;
filename: string;
begin
filename := concat(extractfilepath(application.exename), sName, ’.xls’);
try
ExcelApplication1 := TExcelApplication.Create(Application);
ExcelWorksheet1 := TExcelWorksheet.Create(Application);
ExcelWorkbook1 := TExcelWorkbook.Create(Application);
ExcelApplication1.Connect;
except
Application.Messagebox(’Excel 没有安装!’, ’Hello’, MB_ICONERROR + mb_Ok);
Abort;
end;
try
ExcelApplication1.Workbooks.Add(EmptyParam, 0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet);
AdsData.First;
for j := 0 to AdsData.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel;
ExcelWorksheet1.Cells.item[3, j + 1].font.size := ’10’;
end;
for i := 4 to AdsData.RecordCount + 3 do
begin
for j := 0 to AdsData.Fields.Count - 1 do
begin
ExcelWorksheet1.Cells.item[i, j + 1] :=
AdsData.Fields[j].Asstring;
ExcelWorksheet1.Cells.item[i, j + 1].font.size := ’10’;
end;
AdsData.Next;
end;
ExcelWorksheet1.Columns.AutoFit;
ExcelWorksheet1.Cells.item[1, 2] := Title;
ExcelWorksheet1.Cells.Item[1, 2].font.size := ’14’;
ExcelWorksheet1.SaveAs(filename);
Application.Messagebox(pchar(’数据成功导出’ + filename), ’Hello’,
mb_Ok);
finally
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
ExcelApplication1.Free;
ExcelWorksheet1.Free;
ExcelWorkbook1.Free;
end;
end;
...全文
6 点赞 收藏 1
写回复
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
lzjack 2002-10-07
不会用
回复
发动态
发帖子
Delphi
创建于2007-08-02

4800

社区成员

Delphi 开发及应用
申请成为版主
社区公告
暂无公告