摘自：http://wenjieshiyu.blog.163.com/blog/static/10739413201072033115869/
个人收藏：
Delphi 控制Excel
(一) 使用动态创建的方法
首先创建 Excel
对象，使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject(
'Excel.Application' );
1) 显示当前窗口：
ExcelApp.Visible := True;
2) 更改 Excel
标题栏：
ExcelApp.Caption := '应用程序调用 Microsoft Excel';
3)
添加新工作簿：
ExcelApp.WorkBooks.Add;
4) 打开已存在的工作簿：
ExcelApp.WorkBooks.Open(
'C:\Excel\Demo.xls' );
5)
设置第2个工作表为活动工作表：
ExcelApp.WorkSheets[2].Activate; 或 ExcelApp.WorksSheets[
'Sheet2' ].Activate;
6) 给单元格赋值：
ExcelApp.Cells[1,4].Value :=
'第一行第四列';
7)
设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelApp.ActiveSheet.Columns[1].ColumnsWidth :=
5;
8)
设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelApp.ActiveSheet.Rows[2].RowHeight :=
1/0.035; // 1厘米
9) 在第8行之前插入分页符：
ExcelApp.WorkSheets[1].Rows.PageBreak :=
1;
10) 在第8列之前删除分页符：ExcelApp.ActiveSheet.Columns[4].PageBreak := 0;
11)
指定边框线宽度：
ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight :=
3;
1-左 2-右 3-顶 4-底 5-斜( \ ) 6-斜( / )
12)
清除第一行第四列单元格公式：
ExcelApp.ActiveSheet.Cells[1,4].ClearContents;
13)
设置第一行字体属性：ExcelApp.ActiveSheet.Rows[1].Font.Name :=
'隶书';
ExcelApp.ActiveSheet.Rows[1].Font.Color :=
clBlue;
ExcelApp.ActiveSheet.Rows[1].Font.Bold :=
True;
ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;
14)
进行页面设置：
a.页眉：
ExcelApp.ActiveSheet.PageSetup.CenterHeader :=
'报表演示';
b.页脚：
ExcelApp.ActiveSheet.PageSetup.CenterFooter :=
'第&P页';
c.页眉到顶端边距2cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin
:= 2/0.035;
d.页脚到底端边距3cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin
:= 3/0.035;
e.顶边距2cm：
ExcelApp.ActiveSheet.PageSetup.TopMargin :=
2/0.035;
f.底边距2cm：
ExcelApp.ActiveSheet.PageSetup.BottomMargin :=
2/0.035;
g.左边距2cm：
ExcelApp.ActiveSheet.PageSetup.LeftMargin :=
2/0.035;
h.右边距2cm：
ExcelApp.ActiveSheet.PageSetup.RightMargin :=
2/0.035;
i.页面水平居中：
ExcelApp.ActiveSheet.PageSetup.CenterHorizontally :=
2/0.035;
j.页面垂直居中：
ExcelApp.ActiveSheet.PageSetup.CenterVertically :=
2/0.035;
k.打印单元格网线：
ExcelApp.ActiveSheet.PageSetup.PrintGridLines :=
True;
15) 拷贝操作：
a.拷贝整个工作表：
ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域： ExcelApp.ActiveSheet.Range[
'A1:E2' ].Copy;
c.从A1位置开始粘贴： ExcelApp.ActiveSheet.Range.[ 'A1'
].PasteSpecial;
d.从文件尾部开始粘贴：
ExcelApp.ActiveSheet.Range.PasteSpecial;
16) 插入一行或一列：
a.
ExcelApp.ActiveSheet.Rows[2].Insert;
b.
ExcelApp.ActiveSheet.Columns[1].Insert;
17) 删除一行或一列：
a.
ExcelApp.ActiveSheet.Rows[2].Delete;
b.
ExcelApp.ActiveSheet.Columns[1].Delete;
18)
打印预览工作表：
ExcelApp.ActiveSheet.PrintPreview;
19)
打印输出工作表：
ExcelApp.ActiveSheet.PrintOut;
20) 工作表保存：
if not
ExcelApp.ActiveWorkBook.Saved then
ExcelApp.ActiveSheet.PrintPreview;
21) 工作表另存为：
ExcelApp.SaveAs(
'C:\Excel\Demo1.xls' );
22) 放弃存盘：
ExcelApp.ActiveWorkBook.Saved :=
True;
23) 关闭工作簿：
ExcelApp.WorkBooks.Close;
24) 退出
Excel：
ExcelApp.Quit;
(二) 使用Delphi 控件方法
在Form中分别放入ExcelApplication,
ExcelWorkbook和ExcelWorksheet。
1） 打开Excel
ExcelApplication1.Connect;
2)
显示当前窗口：
ExcelApplication1.Visible[0]:=True;
3) 更改 Excel
标题栏：
ExcelApplication1.Caption := '应用程序调用 Microsoft Excel';
4)
添加新工作簿：
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
5)
添加新工作表：
var Temp_Worksheet:
_WorkSheet;
begin
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)
as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);End;
6)
打开已存在的工作簿：
ExcelApplication1.Workbooks.Open
(c:\a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)
7)
设置第2个工作表为活动工作表：
ExcelApplication1.WorkSheets[2].Activate;
或
ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;
8)
给单元格赋值：
ExcelApplication1.Cells[1,4].Value := '第一行第四列';
9)
设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth
:= 5;
10)
设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelApplication1.ActiveSheet.Rows[2].RowHeight
:= 1/0.035; // 1厘米
11)
在第8行之前插入分页符：
ExcelApplication1.WorkSheets[1].Rows.PageBreak := 1;
12)
在第8列之前删除分页符：
ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;
13)
指定边框线宽度：
ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight :=
3;
1-左 2-右 3-顶 4-底 5-斜( \ ) 6-斜( / )
14)
清除第一行第四列单元格公式：
ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;
15)
设置第一行字体属性：
ExcelApplication1.ActiveSheet.Rows[1].Font.Name :=
'隶书';
ExcelApplication1.ActiveSheet.Rows[1].Font.Color :=
clBlue;
ExcelApplication1.ActiveSheet.Rows[1].Font.Bold :=
True;
ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True;
16)
进行页面设置：
a.页眉：
ExcelApplication1.ActiveSheet.PageSetup.CenterHeader :=
'报表演示';
b.页脚：
ExcelApplication1.ActiveSheet.PageSetup.CenterFooter :=
'第&P页';
c.页眉到顶端边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin :=
2/0.035;
d.页脚到底端边距3cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin :=
3/0.035;
e.顶边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.TopMargin :=
2/0.035;
f.底边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.BottomMargin
:= 2/0.035;
g.左边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.LeftMargin :=
2/0.035;
h.右边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.RightMargin
:= 2/0.035;
i.页面水平居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally :=
2/0.035;
j.页面垂直居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterVertically :=
2/0.035;
k.打印单元格网线：
ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;
17)
拷贝操作：
a.拷贝整个工作表：
ExcelApplication1.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域：
ExcelApplication1.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴：
ExcelApplication1.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴：
ExcelApplication1.ActiveSheet.Range.PasteSpecial;
18) 插入一行或一列：
a.
ExcelApplication1.ActiveSheet.Rows[2].Insert;
b.
ExcelApplication1.ActiveSheet.Columns[1].Insert;
19) 删除一行或一列：
a.
ExcelApplication1.ActiveSheet.Rows[2].Delete;
b.
ExcelApplication1.ActiveSheet.Columns[1].Delete;
20)
打印预览工作表：
ExcelApplication1.ActiveSheet.PrintPreview;
21)
打印输出工作表：
ExcelApplication1.ActiveSheet.PrintOut;
22) 工作表保存：
if not
ExcelApplication1.ActiveWorkBook.Saved then
ExcelApplication1.ActiveSheet.PrintPreview;
23)
工作表另存为：
ExcelApplication1.SaveAs( 'C:\Excel\Demo1.xls' );
24)
放弃存盘：
ExcelApplication1.ActiveWorkBook.Saved := True;
25)
关闭工作簿：
ExcelApplication1.WorkBooks.Close;
26) 退出
Excel：
ExcelApplication1.Quit;
ExcelApplication1.Disconnect;
对不起我还需要一个锁定功能啊，就是输出到EXCEL后只能看，不能进行手工修改
Xl.Cells.Select;//Select All Cells
Xl.Selection.Locked = True;// Lock Selected Cells
//Xl:=CreateOleObject('Excel.Application');
引用 跨网段连接访问
引用 Delphi操作EXCEL -- ::| 分类： 默认分类 | 标签： |举报 |字号大
中
小 订阅 用微信 “扫一扫” 将文章分享到朋友圈。 用易信 “扫一扫” 将文章分享到朋友圈。 下载LOFTER 我的照片书 |
本文转载自有空来坐坐《Delphi操作EXCEL》 引用 有空来坐坐 的 Delphi操作EXCEL 转自 上帝的鱼--专栏 cdsn (最近用到这方面的资料，在网上找了一下，有些方法有待进一步确认) 个人收藏：
Delphi 控制Excel
(一) 使用动态创建的方法
首先创建 Excel 对象，使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject( 'Excel.Application' );
) 显示当前窗口：
ExcelApp.Visible := True;
) 更改 Excel 标题栏：
ExcelApp.Caption := '应用程序调用 Microsoft Excel';
) 添加新工作簿：
ExcelApp.WorkBooks.Add;
) 打开已存在的工作簿：
ExcelApp.WorkBooks.Open( 'C:\Excel\Demo.xls' );
) 设置第2个工作表为活动工作表：
ExcelApp.WorkSheets[].Activate; 或 ExcelApp.WorksSheets[ 'Sheet2' ].Activate;
) 给单元格赋值：
ExcelApp.Cells[,].Value := '第一行第四列';
) 设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelApp.ActiveSheet.Columns[].ColumnsWidth := ;
) 设置指定行的高度（单位：磅）（磅＝0.035厘米），以第二行为例：
ExcelApp.ActiveSheet.Rows[].RowHeight := /0.035; // 1厘米
) 在第8行之前插入分页符：
ExcelApp.WorkSheets[].Rows.PageBreak := ;
) 在第8列之前删除分页符：ExcelApp.ActiveSheet.Columns[].PageBreak := ;
) 指定边框线宽度：
ExcelApp.ActiveSheet.Range[ 'B3:D4' ].Borders[].Weight := ;
-左 -右 -顶 -底 -斜( \ ) -斜( / )
) 清除第一行第四列单元格公式：
ExcelApp.ActiveSheet.Cells[,].ClearContents;
) 设置第一行字体属性：ExcelApp.ActiveSheet.Rows[].Font.Name := '隶书';
ExcelApp.ActiveSheet.Rows[].Font.Color := clBlue;
ExcelApp.ActiveSheet.Rows[].Font.Bold := True;
ExcelApp.ActiveSheet.Rows[].Font.UnderLine := True;
) 进行页面设置：
a.页眉：
ExcelApp.ActiveSheet.PageSetup.CenterHeader := '报表演示';
b.页脚：
ExcelApp.ActiveSheet.PageSetup.CenterFooter := '第&P页';
c.页眉到顶端边距2cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := /0.035;
d.页脚到底端边距3cm：
ExcelApp.ActiveSheet.PageSetup.HeaderMargin := /0.035;
e.顶边距2cm：
ExcelApp.ActiveSheet.PageSetup.TopMargin := /0.035;
f.底边距2cm：
ExcelApp.ActiveSheet.PageSetup.BottomMargin := /0.035;
g.左边距2cm：
ExcelApp.ActiveSheet.PageSetup.LeftMargin := /0.035;
h.右边距2cm：
ExcelApp.ActiveSheet.PageSetup.RightMargin := /0.035;
i.页面水平居中：
ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := /0.035;
j.页面垂直居中：
ExcelApp.ActiveSheet.PageSetup.CenterVertically := /0.035;
k.打印单元格网线：
ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;
) 拷贝操作：
a.拷贝整个工作表： ExcelApp.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域： ExcelApp.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴： ExcelApp.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴： ExcelApp.ActiveSheet.Range.PasteSpecial;
) 插入一行或一列：
a. ExcelApp.ActiveSheet.Rows[].Insert;
b. ExcelApp.ActiveSheet.Columns[].Insert;
) 删除一行或一列：
a. ExcelApp.ActiveSheet.Rows[].Delete;
b. ExcelApp.ActiveSheet.Columns[].Delete;
) 打印预览工作表：
ExcelApp.ActiveSheet.PrintPreview;
) 打印输出工作表：
ExcelApp.ActiveSheet.PrintOut;
) 工作表保存：
if not ExcelApp.ActiveWorkBook.Saved then
ExcelApp.ActiveSheet.PrintPreview;
) 工作表另存为：
ExcelApp.SaveAs( 'C:\Excel\Demo1.xls' );
) 放弃存盘：
ExcelApp.ActiveWorkBook.Saved := True;
) 关闭工作簿：
ExcelApp.WorkBooks.Close;
) 退出 Excel：
ExcelApp.Quit;
(二) 使用Delphi 控件方法
在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。
） 打开Excel
ExcelApplication1.Connect;
) 显示当前窗口：
ExcelApplication1.Visible[]:=True;
) 更改 Excel 标题栏：
ExcelApplication1.Caption := '应用程序调用 Microsoft Excel';
) 添加新工作簿：
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,));
) 添加新工作表：
var Temp_Worksheet: _WorkSheet;
begin
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,) as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);End;
) 打开已存在的工作簿：
ExcelApplication1.Workbooks.Open (c:\a.xls
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,)
) 设置第2个工作表为活动工作表：
ExcelApplication1.WorkSheets[].Activate; 或
ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;
) 给单元格赋值：
ExcelApplication1.Cells[,].Value := '第一行第四列';
) 设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelApplication1.ActiveSheet.Columns[].ColumnsWidth := ;
) 设置指定行的高度（单位：磅）（磅＝0.035厘米），以第二行为例：
ExcelApplication1.ActiveSheet.Rows[].RowHeight := /0.035; // 1厘米
) 在第8行之前插入分页符：
ExcelApplication1.WorkSheets[].Rows.PageBreak := ;
) 在第8列之前删除分页符：
ExcelApplication1.ActiveSheet.Columns[].PageBreak := ;
) 指定边框线宽度：
ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[].Weight := ;
-左 -右 -顶 -底 -斜( \ ) -斜( / )
) 清除第一行第四列单元格公式：
ExcelApplication1.ActiveSheet.Cells[,].ClearContents;
) 设置第一行字体属性：
ExcelApplication1.ActiveSheet.Rows[].Font.Name := '隶书';
ExcelApplication1.ActiveSheet.Rows[].Font.Color := clBlue;
ExcelApplication1.ActiveSheet.Rows[].Font.Bold := True;
ExcelApplication1.ActiveSheet.Rows[].Font.UnderLine := True;
) 进行页面设置：
a.页眉：
ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := '报表演示';
b.页脚：
ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := '第&P页';
c.页眉到顶端边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := /0.035;
d.页脚到底端边距3cm：
ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := /0.035;
e.顶边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.TopMargin := /0.035;
f.底边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := /0.035;
g.左边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := /0.035;
h.右边距2cm：
ExcelApplication1.ActiveSheet.PageSetup.RightMargin := /0.035;
i.页面水平居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := /0.035;
j.页面垂直居中：
ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := /0.035;
k.打印单元格网线：
ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;
) 拷贝操作：
a.拷贝整个工作表：
ExcelApplication1.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域：
ExcelApplication1.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴：
ExcelApplication1.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴：
ExcelApplication1.ActiveSheet.Range.PasteSpecial;
) 插入一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[].Insert;
b. ExcelApplication1.ActiveSheet.Columns[].Insert;
) 删除一行或一列：
a. ExcelApplication1.ActiveSheet.Rows[].Delete;
b. ExcelApplication1.ActiveSheet.Columns[].Delete;
) 打印预览工作表：
ExcelApplication1.ActiveSheet.PrintPreview;
) 打印输出工作表：
ExcelApplication1.ActiveSheet.PrintOut;
) 工作表保存：
if not ExcelApplication1.ActiveWorkBook.Saved then
ExcelApplication1.ActiveSheet.PrintPreview;
) 工作表另存为：
ExcelApplication1.SaveAs( 'C:\Excel\Demo1.xls' );
) 放弃存盘：
ExcelApplication1.ActiveWorkBook.Saved := True;
) 关闭工作簿：
ExcelApplication1.WorkBooks.Close;
) 退出 Excel：
ExcelApplication1.Quit;
ExcelApplication1.Disconnect;
本人 收藏 对不起我还需要一个锁定功能啊，就是输出到EXCEL后只能看，不能进行手工修改 Xl.Cells.Select;//Select All Cells
Xl.Selection.Locked = True;// Lock Selected Cells //Xl:=CreateOleObject('Excel.Application'); -------------------------------------------------------------------------------- procedure TForm1.BitBtn4Click(Sender: TObject);
var
ExcelApp, Sheet: Variant;
begin
if OpenDialog1.Execute then
begin
ExcelApp := CreateOleObject( 'Excel.Application' );
ExcelApp.Workbooks.Open(OpenDialog1.FileName);
Sheet := ExcelApp.ActiveSheet;
Caption := 'Row Count: ' + IntToStr(Sheet.UsedRange.Rows.Count);
ExcelApp.Quit;
Sheet := Unassigned;
ExcelApp := Unassigned;
end;
end; -------------------------------------------------------------------------------- procedure CopyDbDataToExcel(Target: TDbgrid);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[].WorkSheets[].Name := '测试工作薄';
Sheet := XLApp.Workbooks[].WorkSheets['测试工作薄'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first; for iCount := to Target.Columns.Count - do
begin
Sheet.cells[, iCount + ] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount := ;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := to Target.Columns.Count - do
begin
Sheet.cells[jCount + , iCount + ] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end; 看看我的函数
function ExportToExcel(Header: String;
vDataSet: TDataSet): Boolean;
var
I,VL_I,j: integer;
S,SysPath: string;
MsExcel:Variant;
begin
Result:=true;
if Application.MessageBox('您确信将数据导入到Excel吗?','提示！',MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then
begin
SysPath:=ExtractFilePath(application.exename);
with TStringList.Create do
try
vDataSet.First ;
S:=S+Header;
// system.Delete(s,1,1);
add(s);
s:=';
For I:= to vDataSet.fieldcount- do
begin
If vDataSet.fields[I].visible=true then
S:=S+#+vDataSet.fields[I].displaylabel;
end;
system.Delete(s,,);
add(s);
while not vDataSet.Eof do
begin
S := ';
for I := to vDataSet.FieldCount - do
begin
If vDataSet.fields[I].visible=true then
S := S + # + vDataSet.Fields[I].AsString;
end;
System.Delete(S, , );
Add(S);
vDataSet.Next;
end;
Try
SaveToFile(SysPath+'\Tem.xls');
Except
ShowMessage('写文件时发生保护性错误，Excel 如在运行，请先关闭！');
Result:=false;
exit;
end;
finally
Free;
end;
Try
MSExcel:=CreateOleObject('Excel.Application');
Except
ShowMessage('Excel 没有安装，请先安装！');
Result:=false;
exit;
end;
Try
MSExcel.workbooks.open(SysPath+'\Tem.xls');
Except
ShowMessage('打开临时文件时出错，请检查'+SysPath+'\Tem.xls');
Result:=false;
exit;
end;
MSExcel.visible:=True;
for VL_I := to do
MSExcel.Selection.Borders[VL_I].LineStyle := ;
MSExcel.cells.select;
MSExcel.Selection.HorizontalAlignment :=;
MSExcel.Selection.Borders[].LineStyle := ; MSExcel.Range['A1'].Select;
MSExcel.Selection.Font.Size :=; J:= ;
for i:= to vdataset.fieldcount- do
if vDataSet.fields[I].visible then
J:=J+; VL_I :=J;
MSExcel.Range['A1:'+F_ColumnName(VL_I)+''].Select;
MSExcel.Range['A1:'+F_ColumnName(VL_I)+''].Merge;
end
else
Result:=false;
end; 转别人的组件
unit OleExcel; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
comobj, DBTables, Grids;
type
TOLEExcel = class(TComponent)
private
FExcelCreated: Boolean;
FVisible: Boolean;
FExcel: Variant;
FWorkBook: Variant;
FWorkSheet: Variant;
FCellFont: TFont;
FTitleFont: TFont;
FFontChanged: Boolean;
FIgnoreFont: Boolean;
FFileName: TFileName;
procedure SetExcelCellFont(var Cell: Variant);
procedure SetExcelTitleFont(var Cell: Variant);
procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
protected
procedure SetCellFont(NewFont: TFont);
procedure SetTitleFont(NewFont: TFont);
procedure SetVisible(DoShow: Boolean);
function GetCell(ACol, ARow: Integer): string;
procedure SetCell(ACol, ARow: Integer; const Value: string); function GetDateCell(ACol, ARow: Integer): TDateTime;
procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateExcelInstance;
property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
function IsCreated: Boolean;
procedure TableToExcel(const Table: TTable);
procedure QueryToExcel(const Query: TQuery);
procedure StringGridToExcel(const StringGrid: TStringGrid);
procedure SaveToExcel(const FileName: string);
published
property TitleFont: TFont read FTitleFont write SetTitleFont;
property CellFont: TFont read FCellFont write SetCellFont;
property Visible: Boolean read FVisible write SetVisible;
property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
property FileName: TFileName read FFileName write FFileName;
end; procedure Register; implementation constructor TOLEExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIgnoreFont := True;
FCellFont := TFont.Create;
FTitleFont := TFont.Create;
FExcelCreated := False;
FVisible := False;
FFontChanged := False;
end; destructor TOLEExcel.Destroy;
begin
FCellFont.Free;
FTitleFont.Free;
inherited Destroy;
end; procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FCellFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end; procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FTitleFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end; procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
if not FExcelCreated then exit;
if DoShow then
FExcel.Visible := True
else
FExcel.Visible := False;
end; function TOLEExcel.GetCell(ACol, ARow: Integer): string;
begin
if not FExcelCreated then exit;
result := FWorkSheet.Cells[ARow, ACol];
end; procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := Value;
end; function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
if not FExcelCreated then
begin
result := ;
exit;
end;
result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end; procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := '' + DateTimeToStr(Value);
end; procedure TOLEExcel.CreateExcelInstance;
begin
try
FExcel := CreateOLEObject('Excel.Application');
FWorkBook := FExcel.WorkBooks.Add;
FWorkSheet := FWorkBook.WorkSheets.Add;
FExcelCreated := True;
except
FExcelCreated := False;
end;
end; function TOLEExcel.IsCreated: Boolean;
begin
result := FExcelCreated;
end; procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
if NewFont <> FTitleFont then
FTitleFont.Assign(NewFont);
end; procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
if NewFont <> FCellFont then
FCellFont.Assign(NewFont);
end; procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
Col: integer;
begin
for Col := to Table.FieldCount - do
begin
Cell := FWorkSheet.Cells[, Col + ];
SetExcelTitleFont(Cell);
Cell.Value := Table.Fields[Col].FieldName;
end;
end; procedure TOLEExcel.TableToExcel(const Table: TTable);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Table.Active = False then exit; GetTableColumnName(Table, Cell);
Row := ;
with Table do
begin
first;
while not EOF do
begin
for Col := to FieldCount - do
begin
Cell := FWorkSheet.Cells[Row, Col + ];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end; procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
Col: integer;
begin
for Col := to Query.FieldCount - do
begin
Cell := FWorkSheet.Cells[, Col + ];
SetExcelTitleFont(Cell);
Cell.Value := Query.Fields[Col].FieldName;
end;
end; procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Query.Active = False then exit; GetQueryColumnName(Query, Cell);
Row := ;
with Query do
begin
first;
while not EOF do
begin
for Col := to FieldCount - do
begin
Cell := FWorkSheet.Cells[Row, Col + ];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end; procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Col := to StringGrid.FixedCols - do
for Row := to StringGrid.RowCount - do
begin
Cell := FWorkSheet.Cells[Row + , Col + ];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end; procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Row := to StringGrid.FixedRows - do
for Col := to StringGrid.ColCount - do
begin
Cell := FWorkSheet.Cells[Row + , Col + ];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end; procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row, x, y: LongInt;
begin
Col := StringGrid.FixedCols;
Row := StringGrid.FixedRows;
for x := Row to StringGrid.RowCount - do
for y := Col to StringGrid.ColCount - do
begin
Cell := FWorkSheet.Cells[x + , y + ];
SetExcelCellFont(Cell);
Cell.Value := StringGrid.Cells[y, x];
end;
end; procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
GetFixedCols(StringGrid, Cell);
GetFixedRows(StringGrid, Cell);
GetStringGridBody(StringGrid, Cell);
end; procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
if not FExcelCreated then exit;
FWorkSheet.SaveAs(FileName);
end; procedure Register;
begin
RegisterComponents('Tanglu', [TOLEExcel]);
end; end.
---------------------------------------------- 根据别人的组件改写的支持ADO unit AdoToOleExcel; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
comobj, DBTables, Grids,ADODB;
type
TAdoToOleExcel = class(TComponent)
private
FExcelCreated: Boolean;
FVisible: Boolean;
FExcel: Variant;
FWorkBook: Variant;
FWorkSheet: Variant;
FCellFont: TFont;
FTitleFont: TFont;
FFontChanged: Boolean;
FIgnoreFont: Boolean;
FFileName: TFileName;
procedure SetExcelCellFont(var Cell: Variant);
procedure SetExcelTitleFont(var Cell: Variant);
procedure GetTableColumnName(const AdoTable: TAdoTable; var Cell: Variant);
procedure GetQueryColumnName(const AdoQuery: TAdoQuery; var Cell: Variant);
procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
protected
procedure SetCellFont(NewFont: TFont);
procedure SetTitleFont(NewFont: TFont);
procedure SetVisible(DoShow: Boolean);
function GetCell(ACol, ARow: Integer): string;
procedure SetCell(ACol, ARow: Integer; const Value: string); function GetDateCell(ACol, ARow: Integer): TDateTime;
procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateExcelInstance;
property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
function IsCreated: Boolean;
procedure ADOTableToExcel(const ADOTable: TADOTable);
procedure ADOQueryToExcel(const ADOQuery: TADOQuery);
procedure StringGridToExcel(const StringGrid: TStringGrid);
procedure SaveToExcel(const FileName: string);
published
property TitleFont: TFont read FTitleFont write SetTitleFont;
property CellFont: TFont read FCellFont write SetCellFont;
property Visible: Boolean read FVisible write SetVisible;
property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
property FileName: TFileName read FFileName write FFileName;
end; procedure Register; implementation constructor TAdoToOleExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIgnoreFont := True;
FCellFont := TFont.Create;
FTitleFont := TFont.Create;
FExcelCreated := False;
FVisible := False;
FFontChanged := False;
end; destructor TAdoToOleExcel.Destroy;
begin
FCellFont.Free;
FTitleFont.Free;
inherited Destroy;
end; procedure TAdoToOleExcel.SetExcelCellFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FCellFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end; procedure TAdoToOleExcel.SetExcelTitleFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FTitleFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end; procedure TAdoToOleExcel.SetVisible(DoShow: Boolean);
begin
if not FExcelCreated then exit;
if DoShow then
FExcel.Visible := True
else
FExcel.Visible := False;
end; function TAdoToOleExcel.GetCell(ACol, ARow: Integer): string;
begin
if not FExcelCreated then exit;
result := FWorkSheet.Cells[ARow, ACol];
end; procedure TAdoToOleExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := Value;
end; function TAdoToOleExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
if not FExcelCreated then
begin
result := ;
exit;
end;
result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end; procedure TAdoToOleExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := '' + DateTimeToStr(Value);
end; procedure TAdoToOleExcel.CreateExcelInstance;
begin
try
FExcel := CreateOLEObject('Excel.Application');
FWorkBook := FExcel.WorkBooks.Add;
FWorkSheet := FWorkBook.WorkSheets.Add;
FExcelCreated := True;
except
FExcelCreated := False;
end;
end; function TAdoToOleExcel.IsCreated: Boolean;
begin
result := FExcelCreated;
end; procedure TAdoToOleExcel.SetTitleFont(NewFont: TFont);
begin
if NewFont <> FTitleFont then
FTitleFont.Assign(NewFont);
end; procedure TAdoToOleExcel.SetCellFont(NewFont: TFont);
begin
if NewFont <> FCellFont then
FCellFont.Assign(NewFont);
end; procedure TAdoToOleExcel.GetTableColumnName(const ADOTable: TADOTable; var Cell: Variant);
var
Col: integer;
begin
for Col := to ADOTable.FieldCount - do
begin
Cell := FWorkSheet.Cells[, Col + ];
SetExcelTitleFont(Cell);
Cell.Value := ADOTable.Fields[Col].FieldName;
end;
end; procedure TAdoToOleExcel.ADOTableToExcel(const ADOTable: TADOTable);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if ADOTable.Active = False then exit; GetTableColumnName(ADOTable, Cell);
Row := ;
with ADOTable do
begin
first;
while not EOF do
begin
for Col := to FieldCount - do
begin
Cell := FWorkSheet.Cells[Row, Col + ];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end; procedure TAdoToOleExcel.GetQueryColumnName(const ADOQuery: TADOQuery; var Cell: Variant);
var
Col: integer;
begin
for Col := to ADOQuery.FieldCount - do
begin
Cell := FWorkSheet.Cells[, Col + ];
SetExcelTitleFont(Cell);
Cell.Value := ADOQuery.Fields[Col].FieldName;
end;
end; procedure TAdoToOleExcel.ADOQueryToExcel(const ADOQuery: TADOQuery);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if ADOQuery.Active = False then exit; GetQueryColumnName(ADOQuery, Cell);
Row := ;
with ADOQuery do
begin
first;
while not EOF do
begin
for Col := to FieldCount - do
begin
Cell := FWorkSheet.Cells[Row, Col + ];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end; procedure TAdoToOleExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Col := to StringGrid.FixedCols - do
for Row := to StringGrid.RowCount - do
begin
Cell := FWorkSheet.Cells[Row + , Col + ];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end; procedure TAdoToOleExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Row := to StringGrid.FixedRows - do
for Col := to StringGrid.ColCount - do
begin
Cell := FWorkSheet.Cells[Row + , Col + ];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end; procedure TAdoToOleExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row, x, y: LongInt;
begin
Col := StringGrid.FixedCols;
Row := StringGrid.FixedRows;
for x := Row to StringGrid.RowCount - do
for y := Col to StringGrid.ColCount - do
begin
Cell := FWorkSheet.Cells[x + , y + ];
SetExcelCellFont(Cell);
Cell.Value := StringGrid.Cells[y, x];
end;
end; procedure TAdoToOleExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
GetFixedCols(StringGrid, Cell);
GetFixedRows(StringGrid, Cell);
GetStringGridBody(StringGrid, Cell);
end; procedure TAdoToOleExcel.SaveToExcel(const FileName: string);
begin
if not FExcelCreated then exit;
FWorkSheet.SaveAs(FileName);
end; procedure Register;
begin
RegisterComponents('Freeman', [TAdoToOleExcel]);
end; end. -------------------------------------------------------------------------------- 数据导出为Excel格式
首先要创建一个公共单元，名字你们可以随便起。
以下是我创建的公共单元的全部代码：
unit UnitDatatoExcel;
interface
uses
Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
DB, ComObj;
type
TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;
var CustomAttrs, CellData: string) of object;
TDataSetToExcel = class(TComponent)
private
FDataSet: TDataSet;
FOnFormatCell: TKHTMLFormatCellEvent;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Transfer(const FileName: string; Title: string = ');
published
property DataSet: TDataSet read FDataSet write FDataSet;
end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
inherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ');
var
ExcelApp, MyWorkBook: Variant;
i: byte;
j, a: integer;
s, k, b, CustomAttrs: string;
begin
try
ExcelApp := CreateOleObject('Excel.Application');
MyWorkBook := CreateOleObject('Excel.Sheet');
except
on Exception do raise exception.Create('无法打开Excel文件，请确认已经安装Execl')
end;
MyWorkBook := ExcelApp.WorkBooks.Add;
MyWorkBook.WorkSheets[].Range['A1:D1'].Merge(True);
MyWorkBook.WorkSheets[].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[].Cells[, ].Value := Title;
with FDataSet do
begin
i := ;
for j := to FieldCount - do
begin
if Fields[j].Visible then
begin
b := Fields[j].DisplayLabel;
CustomAttrs := ';
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, , i,
Fields[j].FieldName, CustomAttrs, b);
MyWorkBook.WorkSheets[].Cells[i, j + ].Value := b;
end;
end;
i := ;
Close;
Open;
First;
a := ;
while not Eof do
begin
for j := to FieldCount - do
begin
if Fields[j].Visible then
begin
CustomAttrs := ';
k := Fields[j].Text;
if Assigned(FOnFormatCell) then
FOnFormatCell(Self, i, a,
Fields[j].FieldName, CustomAttrs, k);
MyWorkBook.WorkSheets[].Cells[i, j + ].Value := k;
inc(a);
end;
end;
Inc(i);
Next;
end;
end;
s := 'A3:D' + IntToStr(i - );
s := 'A1:D' + IntToStr(i - );
MyWorkBook.WorkSheets[].Columns[].ColumnWidth := ;
MyWorkBook.WorkSheets[].Columns[].ColumnWidth := ;
MyWorkBook.WorkSheets[].Rows[].RowHeight := ;
MyWorkBook.WorkSheets[].Rows[].VerticalAlignMent := $FFFFEFF4;
MyWorkBook.WorkSheets[].Range[s].Font.Name := '仿宋';
s := 'A2:D' + IntToStr(i - );
MyWorkBook.WorkSheets[].Range[s].Borders.LineStyle := ;
MyWorkBook.WorkSheets[].PageSetup.CenterHorizontally := True;
MyWorkBook.WorkSheets[].PageSetup.PrintTitleRows := 'A1';
try
MyWorkBook.Saveas(FileName);
MyWorkBook.Close;
except
MyWorkBook.Close;
end;
ExcelApp.Quit;
ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码：
procedure ToGetherExcel(NewData: TDataSet; NewString: string);
var
DataExcel: TDataSetToExcel;
saveDlg: TSaveDialog;
begin
saveDlg := TSaveDialog.Create(nil); //创建一个存储对话框
DataExcel := TDataSetToExcel.Create(nil);
try
saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';
saveDlg.DefaultExt := 'XLS';
saveDlg.FileName := NewString;
if saveDlg.Execute then
begin
DataExcel.DataSet := NewData; //连接的数据集
DataExcel.DataSet.DisableControls;
DataExcel.Transfer(saveDlg.FileName, NewString);
DataExcel.DataSet.EnableControls;
AlterMesg('导出完毕', '提示信息');
end;
finally
saveDlg.Free;
DataExcel.Free;
end;
end;
如果谁还有比着更好的办法，请告诉我，咱们共同进步：） -------------------------------------------------------------------------------- 我给大伙发一个吧,调用过程，很方便,
这里DBGrid可更改为Query等与数据库相关的
procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);
//uses ComObj;
//sDBGrid:数据源
//Title:标题
//Fn:保存文件
var
ExcelApp: Variant;
i,j,k: Integer;
__ColStr,__s:String;
begin
try
ExcelApp := CreateOleObject('Excel.Application');
except
//on Exception do raise exception.Create('无法创建Xls文件，请确认是否安装EXCEL');
application.MessageBox('系统中的MS Excel软件没有安装或安装不正确！', '错误', MB_ICONERROR + MB_OK);
exit;
end;
ExcelApp.visible := False;
ExcelApp.WorkBooks.Add;
ExcelApp.caption := Title;
__ColStr:=Chr(+sDBGrid.FieldCount-);
ExcelApp.worksheets[].range['A1:'+__ColStr+''].Merge(True);
//写入标题行
ExcelApp.Cells[, ].Value := Title;
ExcelApp.worksheets[].range['A1:'+__ColStr+''].HorizontalAlignment := $FFFFEFF4;
ExcelApp.worksheets[].range['A1:'+__ColStr+''].VerticalAlignment := $FFFFEFF4;
ExcelApp.worksheets[].range['A2:B2'].Merge(True);
ExcelApp.worksheets[].range['C2:D2'].Merge(True);
ExcelApp.Cells[, ].Value := '制表人：'+Myvalue.FUserName;
ExcelApp.Cells[, ].Value := '制表日期：'+DateToStr(Date());
for i := to sDBGrid.FieldCount do begin
//各个字段的宽度
ExcelApp.worksheets[].Columns[i].ColumnWidth:=sDBGrid.Fields[i-].DisplayWidth;
//字段标题
ExcelApp.Cells[, i].Value := sDBGrid.Columns[i-].Title.caption;
end;
ExcelApp.worksheets[].Range['A1:'+__ColStr+''].Font.Name := '黑体';
ExcelApp.worksheets[].Range['A1:'+__ColStr+''].Font.Size := ;
ExcelApp.worksheets[].range['A1:'+__ColStr+''].font.bold:=true;
ExcelApp.worksheets[].Range['A2:'+__ColStr+''].Font.Size := ;
i := ;
k := ;
sDBGrid.DataSource.DataSet.First;
while not sDBGrid.DataSource.DataSet.Eof do begin
for j := to sDBGrid.FieldCount - do begin
ExcelApp.Cells[i, j + ].Value := sDBGrid.Fields[j].AsString;
end;
sDBGrid.DataSource.DataSet.Next;
i := i + ;
k:=k+;
__s:= 'A3:'+__ColStr+IntToStr(i-);
end;
sDBGrid.DataSource.DataSet.First;
ExcelApp.worksheets[].Range[__s].HorizontalAlignment := $FFFFEFF4;
ExcelApp.worksheets[].Range[__s].VerticalAlignment := $FFFFEFF4;
ExcelApp.worksheets[].Range[__s].Font.Name := '宋体';
ExcelApp.worksheets[].Range[__s].Font.Size := ;
ExcelApp.worksheets[].Range[__s].Borders.LineStyle := ;
ExcelApp.ActiveSheet.PageSetup.RightMargin := 0.5/0.035;
ExcelApp.ActiveSheet.PageSetup.LeftMargin := /0.035;
ExcelApp.ActiveSheet.PageSetup.BottomMargin := 0.5/0.035;
ExcelApp.visible := True;
ExcelApp.ActiveCell.Cells.Select;
ExcelApp.Selection.Columns.AutoFit;
try
ExcelApp.ActiveWorkBook.SaveAs(Fn);
except
end;
end; //导出数据到Excel
procedure ToExcel(DBGrid:TDBGrid);
var
ExcelApp: Variant;
i,j,k:integer;
FileName:string;
DlgSave:TsaveDialog;
Begin
DlgSave:=TsaveDialog.Create(nil);
DlgSave.Filter:='*.xls|*.xls';
if DlgSave.Execute then
Begin
application.ProcessMessages;
Filename:=DlgSave.FileName;
ExcelApp := CreateOleObject( 'Excel.Application' );
ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';
ExcelApp.WorkBooks.Add;
application.ProcessMessages;
ExcelApp.WorkSheets[].Activate;
K:=;
For i:= To DBGrid.Columns.Count- Do
Begin
if DBGrid.Columns[i].Visible Then
Begin
ExcelApp.Cells[,K]:=DBGrid.Columns[i].Title.Caption;
k:=k+;
End;{if}
End;{for}
ExcelApp.rows[].font.name:='宋体';
ExcelApp.rows[].font.size:=;
ExcelApp.rows[].Font.Color:=clBlack;
ExcelApp.rows[].Font.Bold:=true;
j:=;
For i:= To DBGrid.Columns.Count- Do
Begin
If DBGrid.Columns[i].Visible Then
Begin
ADOQuery_DB.First;
for k:= To ADOQuery_DB.RecordCount- Do
Begin
ExcelApp.Cells[K+,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;
ADOQuery_DB.Next;
End;{for}
j:=j+;
End;{if}
End;{for}
For I:= To ADOQuery_DB.recordcount Do
ExcelApp.rows[i].Font.SIZE:=;
ExcelApp.Columns.AutoFit;
ExcelApp.ActiveWorkBook.SaveAs(FileName);
ExcelApp.WorkBooks.Close;
Application.MessageBox('数据导出成功....','数据导出',);
ExcelApp.Quit;
ExcelApp:=Unassigned;
DlgSave.Destroy;
End;
end;
测试通过！ -------------------------------------------------------------------------------- 我可以发一段给你
先在程序上放上三个控件，TExcelApplication，TExcelWorkbook，TExcelWorkSheet，它们都在Server组件板上。
要控制Excel，就是采用自动化编程。以Excel作为自动化服务器。
首先，建立与自动化服务器的连接：
Excelapplication1.Connect;
Excelapplication1.Visible[]:=true;
Excelapplication1.Caption:='你要的标题';
ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,) );
Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[] as _worksheet) ; 然后就可以对Excel进行控件了：
从数据库导入数据：
Excel.cells.item[row,col]:=table1.field[i].value;
....
最后不要忘了断开连接
Excelapplication1.disconnect;
Excelapplication1.quit;
至今是delphi菜鸟 ****************************************************************** 如何把在dbgrid的指定几列导到excel表里?
我的做法:用listbox1显示dbgrid的所用供选择列,listbox2用来显示要导出的列:
procedure TForm1.FormCreate(Sender: TObject);
begin
if kadaoTable1.Active then
kadaoTable1.GetFieldNames(Listbox1.Items);
end;
procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段
begin
try
if listbox1.Items.Count= then exit;
if listbox1.Selected[listbox1.ItemIndex] then
begin
Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
Listbox1.Items.Delete(Listbox1.ItemIndex);
if Listbox2.Items.Count>= then
DeleteBitBtn.Enabled:=True;
end;
except
showmessage('你没有选择相应字段!');
end;
end;
procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择
begin
try
if Listbox2.Items.Count= then exit;
if listbox2.Selected[Listbox2.ItemIndex] then
begin
Listbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);
Listbox2.Items.Delete(Listbox2.itemindex);
end;
if Listbox2.Items.Count= then
DeleteBitBtn.Enabled:=False;
except
showmessage('你没有选择相应字段!');
end;
end;
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: 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) + ;
for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[].WorkSheets[I+].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := to TDBGrid(Args[I].VObject).Columns.Count - do
Sheet.Cells[, iCount + ] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := ;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := to TDBGrid(Args[I].VObject).Columns.Count - do
Sheet.Cells[jCount + , iCount + ] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);//导出操作
begin
CopyDbDataToExcel([DBGrid4]);
end;
我 想解决问题有两种办法：一、直接修改CopyDbDataToExcel。二、实现dbgrid4显示的字段列与listbox2中字段同步， dbgrid4中的其余字段要删除掉，不是隐藏。也就是用listbox2中字段来控制哪些字段导入到excel表中呀,如何实现呀? 请高手指点! ***************************** 将dbgrid中数据导出到excel后,如何编写程序使excel的列宽调整为最适合的列宽?
ExcelWorkSheet1.Columns.AutoFit; ************************************ var
s:string;
i,j:integer;
begin
s:='d:\aa\aa.xls'; //文件名
if fileexists(s) then deletefile(s);
v:=CreateOLEObject('Excel.Application'); //建立OLE对象
V.WorkBooks.Add;
if Checkbox1.Checked then
begin
V.Visible:=False; //使Excel可见，并将本程序最小化，以观察Excel的运行情况
end
else
begin
V.Visible:=True; //True
end;
//使Excel窗口不可见 //Application.BringToFront; //程序前置
try
try
Cursor:=crSQLWait;
query1.DisableControls;
For i:= to query1.FieldCount- do //字段数
//注意：Delphi中的数组的下标是从0开始的，
// 而Excel的表格是从1开始编号
begin
V.Goto('R1'+'C'+IntToStr(i+)); //Excel的表格是从1开始编号
V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名
end;
j:=;
query1.First;
while not query1.EOF do
begin
For i:= to query1.FieldCount- do //字段数
begin
V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+));
V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容
end;
query1.Next;
j:=j+;
end;
//设置保护
ShowMessage('数据库到Excel的数据传输完毕!'); except //发生错误时
ShowMessage('没有发现Excel!');
end;
finally
Cursor:=crDefault;
query1.First;
query1.EnableControls;
end;
end; //和上面的差不多，不过不是从DBGrid中导出的！上面的也不是，只是从Query中
导出来。我也想知从DBGrid 中怎么样导出来，或直接打印也行！
************************************************ 直接使用Excel对象，它是标准的COM对象，可以在Delphi中引用的。
我给你一个函数：
function ExportDataToExcel(cds: TClientDataSet; dbGrid: TDBGrid; ExcelAppData: TExcelApplication;
Title, strWhere: String): Boolean;
var
sheet,Range: Variant;
i,j: Integer;
str,fVal: String;
begin
Result := False;
if (cds = nil) or (not cds.Active) then Exit;
try
if ExcelAppData.Tag = then
begin
ExcelAppData.Disconnect;
ExcelAppData.Tag := ;
end;
ExcelAppData.Connect;
ExcelAppData.Visible[] := True;
ExcelAppData.Tag := ;
except
ShowMessage('启动Excel失败，Excel可能没有安装。');
Abort;
end;
cds.DisableControls;
try
if Trim(Title) = ' then Title := '查询结果';
ExcelAppData.Caption := Title;
ExcelAppData.Workbooks.Add(emptyparam,);
sheet := ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[]; sheet.name := Title;
i := (dbGrid.Columns.Count div ) - ;
if i < then i:=;
Sheet.Cells[,i] := Title;
ExcelAppData.StandardFontSize[] := ; //设置表格字体
if dbGrid.Columns.Count < then
begin
str := Char(Ord('A') + dbGrid.Columns.Count -); // 计算最后一列的列标
Range := Sheet.Range['A3:' + str + '']; //取出表头的边界
Range.Columns.Interior.ColorIndex := ; //设置表头的颜色
//计算表格区域
str := 'A3:' + str + IntToStr(cds.RecordCount + );
Range := Sheet.Range[str]; //取出表格数据区域边界
Range.Borders.LineStyle := xlContinuous; // 设置表格的线条
end;
Sheet.Cells[,] := strWhere;//'日期：' + DateToStr(Date);
//写表头
for j := to dbGrid.Columns.Count - do
begin
Sheet.Cells[,j + ] := dbGrid.Columns.Items[j].Title.Caption;
Sheet.Columns.Columns[j+].ColumnWidth := dbGrid.Columns.Items[j].Width div ;
end; //写表的内容
cds.First;
for i:= to cds.RecordCount + do
begin
for j := to dbGrid.Columns.Count - do
begin
fVal := Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);
Sheet.Cells[i,j + ] := fVal;
end;
cds.Next;
end;
Sleep(); //延时1秒，等待Excel处理完成
Result := True;
except on E: Exception do
ShowMessage('数据导出时出现异常！' + E.Message);
end;
ExcelAppData.Disconnect;
cds.EnableControls;
end;