求助Delphi怎样向excel里写数据？

Question

单元：uexceltools
作者：  bear
功能：保存数据集，如ttable,tquery,tclientdataset等为excel文件，
          包含标题，可以只将一部分字段导出
           这一点通过设置dataset中要不导出字段的tag值大于某一个值来处理
原理：调用 microsoft excel ole对象
调用方式：  
                 function datasettoexcel(
                     dataset:tdataset;fieldtagmax:integer;
                      visible:boolean;excelfilename:string=''): boolean;
--------------------------------------------------------------------------------------------------}unit uexceltools;interfaceuses
  classes, comctrls, stdctrls, windows, dialogs, controls, sysutils,
  db,forms,dbclient,comobj;//把数据集导入excelsheet的核心函数
function datasettoexcelsheet
            (
             dataset     :tdataset;
             fieldtagmax :integer;   // 字段的tag值如果大于这个值，就不导出到excel
             sheet       :olevariant
             ): boolean;//实际使用的函数，内部调用了datasettoexcelsheet，在外面加入ui接口和错误处理
function datasettoexcel
            (
             dataset     :tdataset;   // 要转换的数据集
             fieldtagmax :integer;  // 字段的tag值如果大于这个值，就不导出到excel
             visible     :boolean;      // 是否让做转换工作的excel可见
             excelfilename:string='' // excel文件名，*.xls
             ): boolean;implementationfunction datasettoexcelsheet(dataset:tdataset;fieldtagmax:integer;sheet:olevariant): boolean;
var
   row,col,fieldindex :integer;
   bk:tbook;
begin
   result := false;
   if not dataset.active then exit;
   bk:=dataset.getbook;
   dataset.disablecontrols;   sheet.activate;
   try     // 列标题
     row:=1;
     col:=1;
     for fieldindex:=0 to dataset.fieldcount-1 do
         begin
         if dataset.fields[fieldindex].tag <= fieldtagmax then
            begin
            sheet.cells(row,col)  :=dataset.fields[fieldindex].displaylabel;
            inc(col);
            end;
         end;
     // 表内容
     dataset.first;
     while not dataset.eof do
        begin
        row:=row+1;
        col:=1;
        for fieldindex:=0 to dataset.fieldcount-1 do
            begin
            if dataset.fields[fieldindex].tag <= fieldtagmax then
               begin
               sheet.cells(row,col):=dataset.fields[fieldindex].asstring;
               inc(col);
               end;
            end;
        dataset.next;
        end;     result := true;
     finally
       dataset.gotobook(bk);
       dataset.enablecontrols;
    end;  
end;
function datasettoexcel(
                  dataset:tdataset;fieldtagmax:integer;
                  visible:boolean;excelfilename:string=''): boolean;
var
   excelobj, excel, workbook, sheet: olevariant;
    oldcursor:tcursor;
   savedialog:tsavedialog;
begin
   result := false;
   if not dataset.active then exit;   oldcursor:=screen.cursor;
   screen.cursor:=crhourglass;   try
      excelobj := createoleobject('excel.sheet');
      excel := excelobj.application;
      excel.visible := visible ;
      workbook := excel.workbooks.add ;
      sheet:= workbook.sheets[1];
   except
      messagebox(getactivewindow,'无法调用mircorsoft excel! '+chr(13)+chr(10)+
                    '请检查是否安装了mircorsoft excel。','提示',mb_ok+mb_iconinformation);
      screen.cursor:=oldcursor;
      exit;
   end;   result:=datasettoexcelsheet(dataset,fieldtagmax,sheet) ;
   if result then
      if not visible then
         begin
         if excelfilename<>''
            then workbook.saveas(filename:=excelfilename)
            else begin
                 savedialog:=tsavedialog.create(nil);
                 savedialog.filter := 'microsoft excel 文件|*.xls';
                 result:=savedialog.execute;
                 updatewindow(getactivewindow);
                 if result then
                    workbook.saveas(filename:=savedialog.filename);
                 savedialog.free;
                 end;
         excel.quit;
         end;
   screen.cursor:=oldcursor;
end; end.

Answer 1

private
     V:Variant;
       Rows:Integer;
       SheetBoth,SheetWxnl,SheetXjh:Variant;
  public
    { Public declarations }
  end;var
  Form2: TForm2;implementation{$R *.DFM}procedure TForm2.Button1Click(Sender: TObject);
begin
//    V := CreateOleObject('Excel.Application');
//    V.Visible := True;
end;procedure TForm2.Button2Click(Sender: TObject);
var
  wxnl,xjh,Both:string;
  i,j,k:integer;
  jh,jhl: array[1..10] of String;
  s1,s2:String;
begin
    V := CreateOleObject('Excel.Application');
    V.Visible := True;
    Both := GetCurrentDir;
    Wxnl:=Both;
    Xjh:=Both;    Both := Both + '\1.xls';
    Wxnl :=Wxnl + '\wxnl.xls';
    Xjh := Xjh +'\Xjh.xls';
    V.workbooks.add(Both);
    V.workbooks.add(Wxnl);
    V.workbooks.add(Xjh);
//    V.workbooks[1].WorkSheets[1].Activate;
    SheetBoth := V.Workbooks[1].WorkSheets['Sheet1'];
    SheetWxnl := V.Workbooks[2].WorkSheets[1];
    SheetXjh := V.Workbooks[3].WorkSheets[1];
    for i := 3 to 1274 do
    begin
      EdWxnl.Text := SheetWxnl.cells[i,5];
      jh[i]:=EdWxnl.Text ;
      k:=pos('-X',jh[i]);
      s1 := Copy(jh[i],0,k-1);
      if k>0 then
      begin
        for j := 2 to 6435 do
        begin
          s2:=(SheetXjh.Cells[j,1]);
          s2:=Copy(s2,0,Pos('-X',s2)-1);          if s1=s2 then
          begin
            //V.workbooks[3].WorkSheets[1].Activate;
            SheetXjh.Range[''+'A'+IntToStr(j)+':K'+IntToStr(j)+''].Copy;
            //SheetBoth.Range[''+'A'+IntToStr(j)+''].PasteSpecial;
            SheetBoth.Range[''+'A'+IntToStr(i)].PasteSpecial;          end;        end;      end;
//      StringGrid1.Cells[5,i-2].Value:=jh[i];
      EdXjh.Text := SheetXjh.cells[i-1,1];
//      SheetBoth.cells[i-2,1] :=EdWxnl.Text ;
    end;end;procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//     V.DisplayAlerts := False;     V.workbooks.Close;
//     V.DisplayAlerts := True;
//     V.Quit;
end;procedure TForm2.FormDestroy(Sender: TObject);
begin
  if not VarIsEmpty(v) then
    V.Quit;
end;

Answer 2

// 转贴作者：吴晓勇，孙唏瑜今天真倒霉，手机丢了.. 还好找到了这个，呵
一) 使用动态创建的方法首先创建 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;(三) 使用Delphi 控制Excle二维图
在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet
var asheet1,achart, range:variant;1）选择当第一个工作薄第一个工作表
asheet1:=ExcelApplication1.Workbooks[1].Worksheets[1];2）增加一个二维图
achart:=asheet1.chartobjects.add(100,100,200,200);3）选择二维图的形态
achart.chart.charttype:=4;4）给二维图赋值
series:=achart.chart.seriescollection;
range:=sheet1!r2c3:r3c9;
series.add(range,true);
 
5）加上二维图的标题
achart.Chart.HasTitle:=True;
achart.Chart.ChartTitle.Characters.Text:=’ Excle二维图’

Answer 3

忘了说，上面转贴的内容是“用Delphi操作Excel”

Answer 4

我的代码：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, Grids, DBGrids, DBTables,Excel2000,OleServer,ComObj;type
  TForm1 = class(TForm)
    Database1: TDatabase;
    Query1: TQuery;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
with button1 do
if tag=0 then
begin
tag:=1;
caption:='CLOSE';
Query1.Open;
end
else
begin
tag:=0;
caption:='OPEN';
Query1.Close;
end;
end;procedure TForm1.Button2Click(Sender: TObject);
var
myexcel:variant;
workbook:olevariant;
worksheet:olevariant;
i,j,n:integer;
begin
try
myexcel:=createoleobject('excel.application');
myexcel.application.workbooks.add;
myexcel.caption:='导入表';
myexcel.application.visible:=true;
workbook:=myexcel.application.workbooks[1];
worksheet:=workbook.worksheets.item[1];
except
showmessage('excel不存在');
end;
i:=1;
j:=1;
query1.first;
for n:=0 to query1.fieldcount-1 do
begin
worksheet.cells(i,j):=query1.fields[n].displaylabel;
j:=j+1;
end;
query1.first;
while not query1.eof do
begin
inc(i);
for j:=0 to query1.fieldcount-1 do
worksheet.cells[i,j+1]:=query1.fields[j].asstring;
query1.Next;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;end.

Answer 5

用Servers页上的控件
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;部分代码：
  Try
    ExcelApplication1.Connect;
  Except
    showmessage('Excel 错误');
    Abort;
  End;
  ExcelApplication1.Visible[0]:=True;
  ExcelApplication1.Caption:='固定资产查询结果';
  ExcelApplication1.Workbooks.Add(Null,0);
  ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
  ExcelWorksheet1.Activate ;
  ExcelWorksheet1.Visible[1];
  daqresult.first;  j:=1;
  ExcelWorksheet1.Cells.Item[j,1]:='资产编号';
  ExcelWorksheet1.Cells.Item[j,2]:='资产名称';
  ExcelWorksheet1.Cells.Item[j,3]:='分    类';
  ExcelWorksheet1.Cells.Item[j,4]:='原    值';
  ExcelWorksheet1.Cells.Item[j,5]:='使用单位';
  ExcelWorksheet1.Cells.Item[j,6]:='使用情况';
  ExcelWorksheet1.Cells.Item[j,7]:='规格型号';
  ExcelWorksheet1.Cells.Item[j,8]:='存放地点';
  ExcelWorksheet1.Cells.Item[j,9]:='现    值';
  ExcelWorksheet1.Cells.Item[j,10]:='变动日期';
  ExcelWorksheet1.Cells.Item[j,11]:='变动方式';
  j:=2;
  while not daqresult.eof do 
  begin
    for i:=0 to 10 do
      ExcelWorksheet1.Cells.Item[j,i+1]:=mydbgrd.Columns[i].Field.Text ;
    j:=j+1;
    daqresult.next;
  end;
end;