怎样编程将数据输出到EXCL中

给你一个函数：
function TPubData.OutPutDBF(Src:TDBDataSet;SrcGrid:TDBGrid; TrgName: string): Boolean;
var
  elapp,workbook:variant;
  xelfileName: string;
  I,J: integer;
begin
  xelfilename :='c:\temp\'+TrgName+'.xls';
  try
    elapp :=CreateOLEObject('Excel.Application');//;
    workbook := CreateOLEObject('Excel.Sheet');
    workbook := Elapp.workbooks.add;
    For I := 0 to Src.FieldCount - 2 do
      elapp.cells(1,I+1) := SrcGrid.Columns[I].Title.Caption;
    With Src do
    begin
      DisableControls;
      First;
      J := 2;
      While not eof do
      begin
        For I := 1 to Src.FieldCount do
          elapp.cells(J,I) := Fields[I-1].AsString;
        Next;
        Inc(J);
      end;
      First;
      EnableControls;
    end;
    workbook.saveas(xelfilename);
    workbook.close;
    elapp.Quit;
    elapp := unassigned;
  except
    ShowMessage('您的机器里未安装Microsoft Excel');
    exit;
  end;
  ShowMessage(MSG_SAVE_DOON)
end;

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleServer, ExcelXP,ComObj, DB, DBTables, ADODB;type
  TForm1 = class(TForm)
    Button1: TButton;
    ExcelApplication1: TExcelApplication;
    Edit1: TEdit;
    DataSource1: TDataSource;
    Table1: TADOTable;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
     ExcelApp,MyWorkBook,mysheet:Variant;
     i :byte;
     s: string;
begin
    try
      ExcelApp:=CreateOleObject('Excel.Application');
      MyWorkBook:=CreateOleobject('Excel.Sheet');
//?      MyWorkBook:=ExcelApp.workbooks.open('C:\Book1.xls');
    except
      on Exception do raise exception.Create('无法打开Xls文件，请确认已经安装EXCEL')
    end;
    ExcelApp.Visible := true;   //mysheet:=MyWorkBook.WorkSheets[1].name;    MyworkBook:=ExcelApp.workBooks.Add;    //在此处插入读数据库及写Excel文档的代码
    //其中写Excel文档的关键语句如下：
    Myworkbook.worksheets[1].range['A1:D1'].Merge(True);
    Myworkbook.worksheets[1].range['A1:D2'].HorizontalAlignment := alleft;//$FFFFEFF4;
    MyWorkBook.WorkSheets[1].Cells[1,1].Value := 'YourTitle';    i := 2;
    MyWorkBook.WorkSheets[1].Cells[i,1].Value := 'yourCaption1';
    MyWorkBook.WorkSheets[1].Cells[i,2].Value := 'yourCaption2';
    MyWorkBook.WorkSheets[1].Cells[i,3].Value := 'yourCaption3';
    MyWorkBook.WorkSheets[1].Cells[i,4].Value := 'yourCaption4';
    Myworkbook.worksheets[1].Range['A1:D2'].Font.Color := clBlue;
    Myworkbook.worksheets[1].Range['A1:D1'].Font.Name := '隶书';
    Myworkbook.worksheets[1].Range['A1:D1'].Font.Size := 18;
    i := 3;
    table1.close;
    table1.open;
    table1.First;
    while not table1.eof do begin
          MyWorkBook.WorkSheets[1].Cells[i,1].Value := table1.FieldByName('Archive_Code').AsString;
          MyWorkBook.WorkSheets[1].Cells[i,2].Value := table1.FieldByName('Archive_Name').AsString;
          MyWorkBook.WorkSheets[1].Cells[i,3].Value := table1.FieldByName('Archive_GroupID').AsInteger;
          MyWorkBook.WorkSheets[1].Cells[i,4].Value := table1.FieldByName('Archive_KHKind').AsString;
          Inc(i);
          table1.Next
    end;
    ExcelApp.Visible := true;    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';
    //不能设置 papersize 属性, 原因不明
    //MyworkBook.WorkSheets[1].PageSetup.PaperSize := $9;    try
      MyWorkBook.saveas('c:\' + Edit1.Text + '.xls');
      MyWorkBook.close;
    except //当存为一个已有的文档而又不覆盖时将
      MyWorkBook.close; //产生一个例外
    end;
    ExcelApp.Quit;
    ExcelApp:=Unassigned; //释放VARIANT变量end;end.

var ExcelID: Variant;
ExcelID := CreateOleObject( 'Excel.Application' );
1) 显示当前窗口：
ExcelID.Visible := True;
2) 更改 Excel 标题栏：
ExcelID.Caption := '应用程序调用 Microsoft Excel';
3) 添加新工作簿：
ExcelID.WorkBooks.Add;
4) 打开已存在的工作簿：
ExcelID.WorkBooks.Open( 'C:\Excel\Demo.xls' );
5) 设置第2个工作表为活动工作表：
ExcelID.WorkSheets[2].Activate;
或
ExcelID.WorksSheets[ 'Sheet2' ].Activate;
6) 给单元格赋值：
ExcelID.Cells[1,4].Value := '第一行第四列';
7) 设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;
8) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
9) 在第8行之前插入分页符：
ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;
10) 在第8列之前删除分页符：
ExcelID.ActiveSheet.Columns[4].PageBreak := 0;
11) 指定边框线宽度：
ExcelID.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左    2-右   3-顶    4-底   5-斜( \ )     6-斜( / )
12) 清除第一行第四列单元格公式：
ExcelID.ActiveSheet.Cells[1,4].ClearContents;
13) 设置第一行字体属性：
ExcelID.ActiveSheet.Rows[1].Font.Name := '隶书';
ExcelID.ActiveSheet.Rows[1].Font.Color  := clBlue;
ExcelID.ActiveSheet.Rows[1].Font.Bold   := True;
ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;
14)append(a1,b1);

    在很多的时候，我们需要将我们的数据导出到Excel中进行加工，在Access中有现成的工具可以实现
可是在Delphi中却偏偏没有，无论如何我们需要这么一个工具，那么，事不宜迟，细细一想，最好的方法莫过
于直接在程序中按照Excel的格式生成Excel文件，使用Ole技术直接调用Excel实例，由于第一种方法技术实现
过于复杂，好在一般的计算机上已经安装了Office，在此就第二种方法“抛一块砖”。
    在此做一个示例以方便说明，我们考虑到导出数据有很多的情况是Master/Detail数据，因此就用两个
TQuery和一个TDataSource，如果有更多的层次，只需要增加TQuery和TDataSource即可，以下使用了两个TQuery
，分别是：qryMaster和qryDetail，一个TDataSource:dsSource;
    步骤是：
                1.建立一个Excel实例
                2.创建一个工作表
                3.创建一个TStringList，用来装数据
                4.穷举数据表，将数据存入TStringList
                5.将TStringList的数据复制到剪贴板
                6.把剪贴板中的数据粘贴到Excel
     本方法的优点在于：比逐条写入到Excel中的速度大大提高，我曾试过，在P3933，256M的机器上用普通
的方法，导出1000条数据大约需要2分钟，而该用本方法后只需要8秒。function ToExcel():boolean;
var
    y       :integer;
    tsList  :TStringList;
    s       :string;
    aSheet  :Variant;
begin
    result:=true;
    Excel.Connect;                  // 打开Excel
    Excel.Visible[0]:=true;         // 显示Excel
    Excel.Workbooks.Add(xlWBATWorksheet,0);
    aSheet:=excel.Worksheets.Item[1];    tsList:=TStringList.Create;
    try
        try
            with qryMaster do
            begin
                Open;
                First;
                While Not Eof do
                begin
                    s:='';
                    for y:=0 to FieldCount-1 do
                    begin
                        s:=s+Fields[y].AsString+#9;
                        Application.ProcessMessages;
                    end;
                    tsList.Add(s);
                    // 从表
                    if qryDetail<>nil then
                    begin
                        with qryDetail do
                        begin
                            Open;
                            First;
                            while Not Eof do
                            begin
                                s:='';
                                for y:=0 to FieldCount-1 do
                                begin
                                    s:=s+Fields[y].AsString+#9;
                                    Application.ProcessMessages;
                                end;
                                tsList.Add(s);
                                next;
                            end;
                        end;
                    end;
                    next;
                end;
                Close;
            end;
            Clipboard.AsText:=tsList.Text;
        except
            result:=false;
        end;
    finally
        tsList.Free;
    end;    Excel.Disconnect;
    aSheet.Paste;
    MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATION or MB_OK);
end;

调试易

怎样编程将数据输出到EXCL中

解决方案 »