Delphi 如何操作Excel

摘自：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  2010-08-20 15:31:15|  分类： 默认分类 |  标签： |举报 |字号大
中
小 订阅 用微信  “扫一扫”将文章分享到朋友圈。用易信  “扫一扫”将文章分享到朋友圈。下载LOFTER 我的照片书  |
本文转载自有空来坐坐《Delphi操作EXCEL》引用有空来坐坐 的 Delphi操作EXCEL转自  上帝的鱼--专栏  cdsn  (最近用到这方面的资料，在网上找了一下，有些方法有待进一步确认)个人收藏：
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 thenExcelApp.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 thenExcelApplication1.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');--------------------------------------------------------------------------------procedure TForm1.BitBtn4Click(Sender: TObject);
varExcelApp, Sheet: Variant;
beginif OpenDialog1.Execute thenbeginExcelApp := 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);
variCount, jCount: Integer;XLApp: Variant;Sheet: Variant;
beginScreen.Cursor := crHourGlass;if not VarIsEmpty(XLApp) thenbeginXLApp.DisplayAlerts := False;XLApp.Quit;VarClear(XLApp);end;//通过ole创建Excel对象tryXLApp := CreateOleObject('Excel.Application');exceptScreen.Cursor := crDefault;Exit;end;XLApp.WorkBooks.Add[XLWBatWorksheet];XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'];if not Target.DataSource.DataSet.Active thenbeginScreen.Cursor := crDefault;Exit;end;Target.DataSource.DataSet.first;for iCount := 0 to Target.Columns.Count - 1 dobeginSheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;end;jCount := 1;while not Target.DataSource.DataSet.Eof dobeginfor iCount := 0 to Target.Columns.Count - 1 dobeginSheet.cells[jCount + 1, iCount + 1] := 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;
varI,VL_I,j: integer;S,SysPath: string;MsExcel:Variant;
beginResult:=true;if Application.MessageBox('您确信将数据导入到Excel吗?','提示！',MB_OKCANCEL + MB_DEFBUTTON1) = IDOK thenbeginSysPath:=ExtractFilePath(application.exename);with TStringList.Create dotryvDataSet.First ;S:=S+Header;//    system.Delete(s,1,1);
        add(s);s:=';For I:=0 to vDataSet.fieldcount-1 dobeginIf vDataSet.fields[I].visible=true thenS:=S+#9+vDataSet.fields[I].displaylabel;end;system.Delete(s,1,1);add(s);while not vDataSet.Eof dobeginS := ';for I := 0 to vDataSet.FieldCount -1 dobeginIf vDataSet.fields[I].visible=true thenS := S + #9 + vDataSet.Fields[I].AsString;end;System.Delete(S, 1, 1);Add(S);vDataSet.Next;end;TrySaveToFile(SysPath+'\Tem.xls');ExceptShowMessage('写文件时发生保护性错误，Excel 如在运行，请先关闭！');Result:=false;exit;end;finallyFree;end;TryMSExcel:=CreateOleObject('Excel.Application');ExceptShowMessage('Excel 没有安装，请先安装！');Result:=false;exit;end;TryMSExcel.workbooks.open(SysPath+'\Tem.xls');ExceptShowMessage('打开临时文件时出错，请检查'+SysPath+'\Tem.xls');Result:=false;exit;end;MSExcel.visible:=True;for VL_I :=1 to 4 doMSExcel.Selection.Borders[VL_I].LineStyle := 0;MSExcel.cells.select;MSExcel.Selection.HorizontalAlignment :=3;MSExcel.Selection.Borders[1].LineStyle := 0;MSExcel.Range['A1'].Select;MSExcel.Selection.Font.Size :=24;J:=0 ;for i:=0 to vdataset.fieldcount-1 doif vDataSet.fields[I].visible  thenJ:=J+1;VL_I :=J;MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Select;MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Merge;endelseResult:=false;
end;转别人的组件
unit OleExcel;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,comobj, DBTables, Grids;
typeTOLEExcel = class(TComponent)privateFExcelCreated: 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);protectedprocedure 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);publicconstructor 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);publishedproperty 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;implementationconstructor TOLEExcel.Create(AOwner: TComponent);
begininherited Create(AOwner);FIgnoreFont := True;FCellFont := TFont.Create;FTitleFont := TFont.Create;FExcelCreated := False;FVisible := False;FFontChanged := False;
end;destructor TOLEExcel.Destroy;
beginFCellFont.Free;FTitleFont.Free;inherited Destroy;
end;procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
beginif FIgnoreFont then exit;with FCellFont dobeginCell.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);
beginif FIgnoreFont then exit;with FTitleFont dobeginCell.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);
beginif not FExcelCreated then exit;if DoShow thenFExcel.Visible := TrueelseFExcel.Visible := False;
end;function TOLEExcel.GetCell(ACol, ARow: Integer): string;
beginif not FExcelCreated then exit;result := FWorkSheet.Cells[ARow, ACol];
end;procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
varCell: Variant;
beginif not FExcelCreated then exit;Cell := FWorkSheet.Cells[ARow, ACol];SetExcelCellFont(Cell);Cell.Value := Value;
end;function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
beginif not FExcelCreated thenbeginresult := 0;exit;end;result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
varCell: Variant;
beginif not FExcelCreated then exit;Cell := FWorkSheet.Cells[ARow, ACol];SetExcelCellFont(Cell);Cell.Value := '' + DateTimeToStr(Value);
end;procedure TOLEExcel.CreateExcelInstance;
begintryFExcel := CreateOLEObject('Excel.Application');FWorkBook := FExcel.WorkBooks.Add;FWorkSheet := FWorkBook.WorkSheets.Add;FExcelCreated := True;exceptFExcelCreated := False;end;
end;function TOLEExcel.IsCreated: Boolean;
beginresult := FExcelCreated;
end;procedure TOLEExcel.SetTitleFont(NewFont: TFont);
beginif NewFont <> FTitleFont thenFTitleFont.Assign(NewFont);
end;procedure TOLEExcel.SetCellFont(NewFont: TFont);
beginif NewFont <> FCellFont thenFCellFont.Assign(NewFont);
end;procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
varCol: integer;
beginfor Col := 0 to Table.FieldCount - 1 dobeginCell := FWorkSheet.Cells[1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := Table.Fields[Col].FieldName;end;
end;procedure TOLEExcel.TableToExcel(const Table: TTable);
varCol, Row: LongInt;Cell: Variant;
beginif not FExcelCreated then exit;if Table.Active = False then exit;GetTableColumnName(Table, Cell);Row := 2;with Table dobeginfirst;while not EOF dobeginfor Col := 0 to FieldCount - 1 dobeginCell := FWorkSheet.Cells[Row, Col + 1];SetExcelCellFont(Cell);Cell.Value := Fields[Col].AsString;end;next;Inc(Row);end;end;
end;procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
varCol: integer;
beginfor Col := 0 to Query.FieldCount - 1 dobeginCell := FWorkSheet.Cells[1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := Query.Fields[Col].FieldName;end;
end;procedure TOLEExcel.QueryToExcel(const Query: TQuery);
varCol, Row: LongInt;Cell: Variant;
beginif not FExcelCreated then exit;if Query.Active = False then exit;GetQueryColumnName(Query, Cell);Row := 2;with Query dobeginfirst;while not EOF dobeginfor Col := 0 to FieldCount - 1 dobeginCell := FWorkSheet.Cells[Row, Col + 1];SetExcelCellFont(Cell);Cell.Value := Fields[Col].AsString;end;next;Inc(Row);end;end;
end;procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row: LongInt;
beginfor Col := 0 to StringGrid.FixedCols - 1 dofor Row := 0 to StringGrid.RowCount - 1 dobeginCell := FWorkSheet.Cells[Row + 1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := StringGrid.Cells[Col, Row];end;
end;procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row: LongInt;
beginfor Row := 0 to StringGrid.FixedRows - 1 dofor Col := 0 to StringGrid.ColCount - 1 dobeginCell := FWorkSheet.Cells[Row + 1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := StringGrid.Cells[Col, Row];end;
end;procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row, x, y: LongInt;
beginCol := StringGrid.FixedCols;Row := StringGrid.FixedRows;for x := Row to StringGrid.RowCount - 1 dofor y := Col to StringGrid.ColCount - 1 dobeginCell := FWorkSheet.Cells[x + 1, y + 1];SetExcelCellFont(Cell);Cell.Value := StringGrid.Cells[y, x];end;
end;procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
varCell: Variant;
beginif not FExcelCreated then exit;GetFixedCols(StringGrid, Cell);GetFixedRows(StringGrid, Cell);GetStringGridBody(StringGrid, Cell);
end;procedure TOLEExcel.SaveToExcel(const FileName: string);
beginif not FExcelCreated then exit;FWorkSheet.SaveAs(FileName);
end;procedure Register;
beginRegisterComponents('Tanglu', [TOLEExcel]);
end;end.
---------------------------------------------- 根据别人的组件改写的支持ADOunit AdoToOleExcel;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,comobj, DBTables, Grids,ADODB;
typeTAdoToOleExcel = class(TComponent)privateFExcelCreated: 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);protectedprocedure 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);publicconstructor 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);publishedproperty 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;implementationconstructor TAdoToOleExcel.Create(AOwner: TComponent);
begininherited Create(AOwner);FIgnoreFont := True;FCellFont := TFont.Create;FTitleFont := TFont.Create;FExcelCreated := False;FVisible := False;FFontChanged := False;
end;destructor TAdoToOleExcel.Destroy;
beginFCellFont.Free;FTitleFont.Free;inherited Destroy;
end;procedure TAdoToOleExcel.SetExcelCellFont(var Cell: Variant);
beginif FIgnoreFont then exit;with FCellFont dobeginCell.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);
beginif FIgnoreFont then exit;with FTitleFont dobeginCell.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);
beginif not FExcelCreated then exit;if DoShow thenFExcel.Visible := TrueelseFExcel.Visible := False;
end;function TAdoToOleExcel.GetCell(ACol, ARow: Integer): string;
beginif not FExcelCreated then exit;result := FWorkSheet.Cells[ARow, ACol];
end;procedure TAdoToOleExcel.SetCell(ACol, ARow: Integer; const Value: string);
varCell: Variant;
beginif not FExcelCreated then exit;Cell := FWorkSheet.Cells[ARow, ACol];SetExcelCellFont(Cell);Cell.Value := Value;
end;function TAdoToOleExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
beginif not FExcelCreated thenbeginresult := 0;exit;end;result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;procedure TAdoToOleExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
varCell: Variant;
beginif not FExcelCreated then exit;Cell := FWorkSheet.Cells[ARow, ACol];SetExcelCellFont(Cell);Cell.Value := '' + DateTimeToStr(Value);
end;procedure TAdoToOleExcel.CreateExcelInstance;
begintryFExcel := CreateOLEObject('Excel.Application');FWorkBook := FExcel.WorkBooks.Add;FWorkSheet := FWorkBook.WorkSheets.Add;FExcelCreated := True;exceptFExcelCreated := False;end;
end;function TAdoToOleExcel.IsCreated: Boolean;
beginresult := FExcelCreated;
end;procedure TAdoToOleExcel.SetTitleFont(NewFont: TFont);
beginif NewFont <> FTitleFont thenFTitleFont.Assign(NewFont);
end;procedure TAdoToOleExcel.SetCellFont(NewFont: TFont);
beginif NewFont <> FCellFont thenFCellFont.Assign(NewFont);
end;procedure TAdoToOleExcel.GetTableColumnName(const ADOTable: TADOTable; var Cell: Variant);
varCol: integer;
beginfor Col := 0 to ADOTable.FieldCount - 1 dobeginCell := FWorkSheet.Cells[1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := ADOTable.Fields[Col].FieldName;end;
end;procedure TAdoToOleExcel.ADOTableToExcel(const ADOTable: TADOTable);
varCol, Row: LongInt;Cell: Variant;
beginif not FExcelCreated then exit;if ADOTable.Active = False then exit;GetTableColumnName(ADOTable, Cell);Row := 2;with ADOTable dobeginfirst;while not EOF dobeginfor Col := 0 to FieldCount - 1 dobeginCell := FWorkSheet.Cells[Row, Col + 1];SetExcelCellFont(Cell);Cell.Value := Fields[Col].AsString;end;next;Inc(Row);end;end;
end;procedure TAdoToOleExcel.GetQueryColumnName(const ADOQuery: TADOQuery; var Cell: Variant);
varCol: integer;
beginfor Col := 0 to ADOQuery.FieldCount - 1 dobeginCell := FWorkSheet.Cells[1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := ADOQuery.Fields[Col].FieldName;end;
end;procedure TAdoToOleExcel.ADOQueryToExcel(const ADOQuery: TADOQuery);
varCol, Row: LongInt;Cell: Variant;
beginif not FExcelCreated then exit;if ADOQuery.Active = False then exit;GetQueryColumnName(ADOQuery, Cell);Row := 2;with ADOQuery dobeginfirst;while not EOF dobeginfor Col := 0 to FieldCount - 1 dobeginCell := FWorkSheet.Cells[Row, Col + 1];SetExcelCellFont(Cell);Cell.Value := Fields[Col].AsString;end;next;Inc(Row);end;end;
end;procedure TAdoToOleExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row: LongInt;
beginfor Col := 0 to StringGrid.FixedCols - 1 dofor Row := 0 to StringGrid.RowCount - 1 dobeginCell := FWorkSheet.Cells[Row + 1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := StringGrid.Cells[Col, Row];end;
end;procedure TAdoToOleExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row: LongInt;
beginfor Row := 0 to StringGrid.FixedRows - 1 dofor Col := 0 to StringGrid.ColCount - 1 dobeginCell := FWorkSheet.Cells[Row + 1, Col + 1];SetExcelTitleFont(Cell);Cell.Value := StringGrid.Cells[Col, Row];end;
end;procedure TAdoToOleExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
varCol, Row, x, y: LongInt;
beginCol := StringGrid.FixedCols;Row := StringGrid.FixedRows;for x := Row to StringGrid.RowCount - 1 dofor y := Col to StringGrid.ColCount - 1 dobeginCell := FWorkSheet.Cells[x + 1, y + 1];SetExcelCellFont(Cell);Cell.Value := StringGrid.Cells[y, x];end;
end;procedure TAdoToOleExcel.StringGridToExcel(const StringGrid: TStringGrid);
varCell: Variant;
beginif not FExcelCreated then exit;GetFixedCols(StringGrid, Cell);GetFixedRows(StringGrid, Cell);GetStringGridBody(StringGrid, Cell);
end;procedure TAdoToOleExcel.SaveToExcel(const FileName: string);
beginif not FExcelCreated then exit;FWorkSheet.SaveAs(FileName);
end;procedure Register;
beginRegisterComponents('Freeman', [TAdoToOleExcel]);
end;end.--------------------------------------------------------------------------------数据导出为Excel格式
首先要创建一个公共单元，名字你们可以随便起。
以下是我创建的公共单元的全部代码：
unit UnitDatatoExcel;
interface
usesWindows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,DB, ComObj;
typeTKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;var CustomAttrs, CellData: string) of object;TDataSetToExcel = class(TComponent)privateFDataSet: TDataSet;FOnFormatCell: TKHTMLFormatCellEvent;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;procedure Transfer(const FileName: string; Title: string = ');publishedproperty DataSet: TDataSet read FDataSet write FDataSet;end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begininherited Create(AOwner);FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begininherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ');
varExcelApp, MyWorkBook: Variant;i: byte;j, a: integer;s, k, b, CustomAttrs: string;
begintryExcelApp := CreateOleObject('Excel.Application');MyWorkBook := CreateOleObject('Excel.Sheet');excepton Exception do raise exception.Create('无法打开Excel文件，请确认已经安装Execl')end;MyWorkBook := ExcelApp.WorkBooks.Add;MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;with FDataSet dobegini := 2;for j := 0 to FieldCount - 1 dobeginif Fields[j].Visible thenbeginb := Fields[j].DisplayLabel;CustomAttrs := ';if Assigned(FOnFormatCell) thenFOnFormatCell(Self, 1, i,Fields[j].FieldName, CustomAttrs, b);MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;end;end;i := 3;Close;Open;First;a := 2;while not Eof dobeginfor j := 0 to FieldCount - 1 dobeginif Fields[j].Visible thenbeginCustomAttrs := ';k := Fields[j].Text;if Assigned(FOnFormatCell) thenFOnFormatCell(Self, i, a,Fields[j].FieldName, CustomAttrs, k);MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;inc(a);end;end;Inc(i);Next;end;end;s := 'A3:D' + IntToStr(i - 1);s := 'A1:D' + IntToStr(i - 1);MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋';s := 'A2:D' + IntToStr(i - 1);MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';tryMyWorkBook.Saveas(FileName);MyWorkBook.Close;exceptMyWorkBook.Close;end;ExcelApp.Quit;ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码：
procedure ToGetherExcel(NewData: TDataSet; NewString: string);
varDataExcel: TDataSetToExcel;saveDlg: TSaveDialog;
beginsaveDlg := TSaveDialog.Create(nil);  //创建一个存储对话框DataExcel := TDataSetToExcel.Create(nil);trysaveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';saveDlg.DefaultExt := 'XLS';saveDlg.FileName := NewString;if saveDlg.Execute thenbeginDataExcel.DataSet := NewData;  //连接的数据集
      DataExcel.DataSet.DisableControls;DataExcel.Transfer(saveDlg.FileName, NewString);DataExcel.DataSet.EnableControls;AlterMesg('导出完毕', '提示信息');end;finallysaveDlg.Free;DataExcel.Free;end;
end;
如果谁还有比着更好的办法，请告诉我，咱们共同进步：）--------------------------------------------------------------------------------我给大伙发一个吧,调用过程，很方便,
这里DBGrid可更改为Query等与数据库相关的
procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);
//uses ComObj;
//sDBGrid:数据源
//Title:标题
//Fn:保存文件
varExcelApp: Variant;i,j,k: Integer;__ColStr,__s:String;
begintryExcelApp := 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(65+sDBGrid.FieldCount-1);ExcelApp.worksheets[1].range['A1:'+__ColStr+'1'].Merge(True);//写入标题行ExcelApp.Cells[1, 1].Value := Title;ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].HorizontalAlignment := $FFFFEFF4;ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].VerticalAlignment := $FFFFEFF4;ExcelApp.worksheets[1].range['A2:B2'].Merge(True);ExcelApp.worksheets[1].range['C2:D2'].Merge(True);ExcelApp.Cells[2, 1].Value := '制表人：'+Myvalue.FUserName;ExcelApp.Cells[2, 3].Value := '制表日期：'+DateToStr(Date());for i := 1 to sDBGrid.FieldCount do begin//各个字段的宽度ExcelApp.worksheets[1].Columns[i].ColumnWidth:=sDBGrid.Fields[i-1].DisplayWidth;//字段标题ExcelApp.Cells[3, i].Value := sDBGrid.Columns[i-1].Title.caption;end;ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Name := '黑体';ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Size := 16;ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].font.bold:=true;ExcelApp.worksheets[1].Range['A2:'+__ColStr+'3'].Font.Size := 10;i := 4;k := 0;sDBGrid.DataSource.DataSet.First;while not sDBGrid.DataSource.DataSet.Eof do beginfor j := 0 to sDBGrid.FieldCount - 1 do beginExcelApp.Cells[i, j + 1].Value := sDBGrid.Fields[j].AsString;end;sDBGrid.DataSource.DataSet.Next;i := i + 1;k:=k+1;__s:= 'A3:'+__ColStr+IntToStr(i-1);end;sDBGrid.DataSource.DataSet.First;ExcelApp.worksheets[1].Range[__s].HorizontalAlignment := $FFFFEFF4;ExcelApp.worksheets[1].Range[__s].VerticalAlignment := $FFFFEFF4;ExcelApp.worksheets[1].Range[__s].Font.Name := '宋体';ExcelApp.worksheets[1].Range[__s].Font.Size := 10;ExcelApp.worksheets[1].Range[__s].Borders.LineStyle := 1;ExcelApp.ActiveSheet.PageSetup.RightMargin := 0.5/0.035;ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;ExcelApp.ActiveSheet.PageSetup.BottomMargin := 0.5/0.035;ExcelApp.visible := True;ExcelApp.ActiveCell.Cells.Select;ExcelApp.Selection.Columns.AutoFit;tryExcelApp.ActiveWorkBook.SaveAs(Fn);exceptend;
end;//导出数据到Excel
procedure ToExcel(DBGrid:TDBGrid);
varExcelApp: Variant;i,j,k:integer;FileName:string;DlgSave:TsaveDialog;
BeginDlgSave:=TsaveDialog.Create(nil);DlgSave.Filter:='*.xls|*.xls';if DlgSave.Execute thenBeginapplication.ProcessMessages;Filename:=DlgSave.FileName;ExcelApp := CreateOleObject( 'Excel.Application' );ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';
    ExcelApp.WorkBooks.Add;application.ProcessMessages;ExcelApp.WorkSheets[1].Activate;K:=1;For i:=0 To DBGrid.Columns.Count-1 DoBeginif DBGrid.Columns[i].Visible ThenBeginExcelApp.Cells[1,K]:=DBGrid.Columns[i].Title.Caption;k:=k+1;End;{if}End;{for}ExcelApp.rows[1].font.name:='宋体';ExcelApp.rows[1].font.size:=10;ExcelApp.rows[1].Font.Color:=clBlack;ExcelApp.rows[1].Font.Bold:=true;j:=1;For i:=0 To DBGrid.Columns.Count-1 DoBeginIf DBGrid.Columns[i].Visible ThenBeginADOQuery_DB.First;for k:=1 To ADOQuery_DB.RecordCount-1 DoBeginExcelApp.Cells[K+1,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;ADOQuery_DB.Next;End;{for}j:=j+1;End;{if}End;{for}For I:=1 To ADOQuery_DB.recordcount DoExcelApp.rows[i].Font.SIZE:=9;ExcelApp.Columns.AutoFit;ExcelApp.ActiveWorkBook.SaveAs(FileName);ExcelApp.WorkBooks.Close;Application.MessageBox('数据导出成功....','数据导出',0);ExcelApp.Quit;ExcelApp:=Unassigned;DlgSave.Destroy;End;
end;
测试通过！--------------------------------------------------------------------------------我可以发一段给你
先在程序上放上三个控件，TExcelApplication，TExcelWorkbook，TExcelWorkSheet，它们都在Server组件板上。
要控制Excel，就是采用自动化编程。以Excel作为自动化服务器。
首先，建立与自动化服务器的连接：Excelapplication1.Connect;Excelapplication1.Visible[0]:=true;Excelapplication1.Caption:='你要的标题';ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,0) );Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[0] 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);
beginif kadaoTable1.Active thenkadaoTable1.GetFieldNames(Listbox1.Items);
end;
procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段
begintryif listbox1.Items.Count=0 then exit;if listbox1.Selected[listbox1.ItemIndex] thenbeginListbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);Listbox1.Items.Delete(Listbox1.ItemIndex);if Listbox2.Items.Count>=1 thenDeleteBitBtn.Enabled:=True;end;exceptshowmessage('你没有选择相应字段!');end;
end;
procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择
begintryif Listbox2.Items.Count=0 then exit;if listbox2.Selected[Listbox2.ItemIndex] thenbeginListbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);Listbox2.Items.Delete(Listbox2.itemindex);end;if Listbox2.Items.Count=0 thenDeleteBitBtn.Enabled:=False;exceptshowmessage('你没有选择相应字段!');end;end;
procedure CopyDbDataToExcel(Args: array of const);
variCount, jCount: Integer;XLApp: Variant;Sheet: Variant;I: Integer;
beginScreen.Cursor := crHourGlass;if not VarIsEmpty(XLApp) thenbeginXLApp.DisplayAlerts := False;XLApp.Quit;VarClear(XLApp);end;tryXLApp := CreateOleObject('excel.Application');exceptScreen.Cursor := crDefault;Exit;end;XLApp.WorkBooks.Add;XLApp.SheetsInNewWorkbook := High(Args) + 1;for I := Low(Args) to High(Args) dobeginXLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active thenbeginScreen.Cursor := crDefault;Exit;end;TDBGrid(Args[I].VObject).DataSource.DataSet.first;for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 doSheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;jCount := 1;while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof dobeginfor iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 doSheet.Cells[jCount + 1, iCount + 1] := 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;************************************vars:string;i,j:integer;
begins:='d:\aa\aa.xls'; //文件名if fileexists(s) then deletefile(s);v:=CreateOLEObject('Excel.Application'); //建立OLE对象
  V.WorkBooks.Add;if Checkbox1.Checked thenbeginV.Visible:=False;//使Excel可见，并将本程序最小化，以观察Excel的运行情况endelsebeginV.Visible:=True;    //Trueend;//使Excel窗口不可见//Application.BringToFront; //程序前置trytryCursor:=crSQLWait;query1.DisableControls;For i:=0 to query1.FieldCount-1 do //字段数//注意：Delphi中的数组的下标是从0开始的，// 而Excel的表格是从1开始编号beginV.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名end;j:=2;query1.First;while not query1.EOF dobeginFor i:=0 to query1.FieldCount-1 do //字段数beginV.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容end;query1.Next;j:=j+1;end;//设置保护ShowMessage('数据库到Excel的数据传输完毕!');except //发生错误时ShowMessage('没有发现Excel!');end;finallyCursor:=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;
varsheet,Range: Variant;i,j: Integer;str,fVal: String;
beginResult := False;if (cds = nil) or (not cds.Active) then Exit;tryif ExcelAppData.Tag = 1 thenbeginExcelAppData.Disconnect;ExcelAppData.Tag := 0;end;ExcelAppData.Connect;ExcelAppData.Visible[0] := True;ExcelAppData.Tag := 1;exceptShowMessage('启动Excel失败，Excel可能没有安装。');Abort;end;cds.DisableControls;tryif Trim(Title) = ' then Title := '查询结果';ExcelAppData.Caption := Title;ExcelAppData.Workbooks.Add(emptyparam,0);sheet := ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[1];sheet.name := Title;i := (dbGrid.Columns.Count div 2) - 1;if i < 1 then i:=1;Sheet.Cells[1,i] := Title;ExcelAppData.StandardFontSize[0] := 9; //设置表格字体if dbGrid.Columns.Count < 24 thenbeginstr := Char(Ord('A') + dbGrid.Columns.Count -1); // 计算最后一列的列标Range := Sheet.Range['A3:' + str + '3'];  //取出表头的边界Range.Columns.Interior.ColorIndex := 8;   //设置表头的颜色//计算表格区域str := 'A3:' + str + IntToStr(cds.RecordCount + 3);Range := Sheet.Range[str]; //取出表格数据区域边界Range.Borders.LineStyle := xlContinuous;   // 设置表格的线条end;Sheet.Cells[2,1] := strWhere;//'日期：' + DateToStr(Date);//写表头for j := 0 to dbGrid.Columns.Count -1 dobeginSheet.Cells[3,j + 1] := dbGrid.Columns.Items[j].Title.Caption;Sheet.Columns.Columns[j+1].ColumnWidth := dbGrid.Columns.Items[j].Width div 6;end;//写表的内容
    cds.First;for i:= 4 to cds.RecordCount + 3 dobeginfor j := 0 to dbGrid.Columns.Count - 1 dobeginfVal := Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);Sheet.Cells[i,j + 1] := fVal;end;cds.Next;end;Sleep(1000);   //延时1秒，等待Excel处理完成Result := True;except on E: Exception doShowMessage('数据导出时出现异常！' + E.Message);end;ExcelAppData.Disconnect;cds.EnableControls;
end;

posted on 2018-10-03 18:20 向北方 阅读(...) 评论(...) 编辑 收藏

转载于:https://www.cnblogs.com/China3S/p/9740377.html

Delphi 如何操作Excel相关推荐

  1. 用delphi操作excel

    用delphi操作excel (一) 使用动态创建的方法 首先创建 Excel 对象,使用ComObj: var ExcelApp: Variant; ExcelApp := CreateOleObj ...

  2. Delphi OLE方法操作Excel

    Delphi OLE方法操作Excel  来源:http://www.ltesting.net/ceshi/ruanjianceshikaifajishu/rjcskfyy/2008/0519/154 ...

  3. C#操作Excel文件（转）

    摘要:本文介绍了Excel对象.C#中的受管代码和非受管代码,并介绍了COM组件在.net环境中的使用. 关键词:受管代码:非受管代码:Excel对象:动态连接库 引言 Excel是微软公司办公自动化 ...

  4. Qt之操作Excel

    Visual Basic for Applications(VBA)是一种Visual Basic的一种宏语言,主要能用来扩展Windows的应用程式功能,特别是Microsoft Office软件. ...

  5. c#如何操作excel??

           登 录..      [注 册]      忘记密码      注销登录 <script>document.write('');</script> csdn.ne ...

  6. python excel操作单元格_python 操作excel表格的方法

    说明:由于公司oa暂缺,人事妹子在做考勤的时候,需要通过几个excel表格去交叉比对员工是否有旷工或迟到,工作量大而且容易出错. 这时候it屌丝的机会来啦,花了一天时间给妹子撸了一个自动化脚本. 1. ...

  7. C#在客户端和服务端操作Excel文件

    一.在客户端把数据导入到Excel文件步骤 1.创建Excel application对象,打开或生成Excel文件 //服务端创建StringBuilder对象     System.Text.St ...

  8. C#如何在Form中嵌入并且操作Excel表格

    网上比较多讲述如何操作excel表的文章,但都是启动excel的窗口来打开excel数据文件.有时候需要把excel表嵌入到自己程序的form中,给客户一个不用切换窗口的操作界面,似乎更好.这在vc中 ...

  9. c#操作Excel整理总结

    大家好,这是我在工作中总结的关于C#操作Excel的帮助类,欢迎大家批评指正! using System; using System.Collections.Generic; using System ...

最新文章

  1. 梦美生命获1亿元A轮融资，鼎晖领投
  2. python 列表维度_如何输出python中list的维度
  3. @AUTORELEASEPOOL
  4. 逾期怎么处理_招商信用卡逾期三个月银行起诉我怎么处理？信用卡逾期一年半收到短信发到户籍所在地...
  5. ACM主要赛考察内容
  6. 定位导致物化视图无法快速刷新的原因
  7. Angular 条件指令 ngIf 的一个例子
  8. facenet训练自己的数据_①如何帮助自己简易分析体测数据②没有私教一个人无法开始训练？...
  9. maven中设置代理服务器
  10. 节点大小可变的环形队列实现
  11. HDFS分布式文件系统知识总结
  12. 极客大学架构师训练营 架构师职责 听课总结 -- 第一课
  13. python编程实战(三):暴力破解WIFI密码！亲测运行有效！
  14. CentOS6.5服务器端口捆绑
  15. Linux应用程序动态更改用户ID
  16. 庄树松勇挫老将黄海刚 硬汉将复仇伊泽波人
  17. 通过图形界面对MySQL数据库进行操作
  18. Mysql场景刷数据库脚本方法和顺序
  19. DATAKIT CrossManager 2022.4 Crack
  20. 网络系统安全课程--目录

热门文章

  1. 百度文库推出“文源计划”
  2. 解决串口通信时会导致鼠标乱跳的问题
  3. html怎么用新页面打开页面打开网页,javascript如何打开新窗口？
  4. simulink实现HDB3基带通信系统
  5. 2013 年科技界即将发生的 10 件大事
  6. 经典Windows编程书单
  7. FDDB生成ROC曲线
  8. C#中Guid.ToString (String)五种格式,以及将32位的GUID转为16位及其他格式
  9. 并查集（python代码实现）
  10. 机器视觉工业相机选型