一个把Table控件查询出来的数据导出Excel的问题

Question

//try:
begin
           stringlist:= TStringList.Create;
         try
           for i := 0 to  DBGrid.DataSource.DataSet.FieldCount - 1 do
             if DBGrid.Columns[i].Visible then
               strLine := strLine + DBGrid.DataSource.DataSet.Fields[i].FieldName + chr(9);
           stringlist.Add(strLine);
           DBGrid.DataSource.DataSet.First;
           while( not DBGrid.DataSource.DataSet.Eof) do
             begin               strLine :='';
               for i := 0 to  DBGrid.DataSource.DataSet.FieldCount - 1 do
                 if DBGrid.Columns[i].Visible then
                   strLine := strLine + DBGrid.DataSource.DataSet.Fields[i].AsString + chr(9);               stringlist.Add(strLine);
               DBGrid.DataSource.DataSet.Next;
             end;          finally
            stringlist.SaveToFile(SaveDialog.FileName);
            stringlist.Free;
          end;

Answer 1

or:procedure TDMFun.SaveToExcel(Grid:TDBGrid;const FileName,SheetTitle:string);
var
  RowNum,ColNum,RecordNum: integer;
  ExcelWorkbook1: TExcelWorkbook;
  ExcelWorksheet1: TExcelWorksheet;
  ExcelApplication1: TExcelApplication;
begin
    try
      ExcelApplication1 := TExcelApplication.Create(Self);
      ExcelWorkbook1 := TExcelWorkbook.Create(Self);
      ExcelWorkSheet1 := TExcelWorksheet.Create(Self);
    except
      showmessage('对不起，您没有安装Excel 2000!');
      abort;
    end;
  ExcelApplication1.Connect;
  ExcelApplication1.Workbooks.Add(null,0);
  ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Sheets[1] as _WorkSheet);
  if Grid.DataSource.DataSet.RecordCount > 0 then
  begin
  ExcelWorkSheet1.Name:=SheetTiTle;
  ExcelworkSheet1.Cells.Clear;
  for ColNum:=0 to Grid.FieldCount-1 do
  begin
    ExcelWorkSheet1.cells.Item[2, colNum+1].font.size := 13;
    ExcelWorkSheet1.cells.Item[2, colNum+1].Font.Bold := True;
    ExcelWorkSheet1.cells.Item[2, colNum+1] :=Grid.Columns[colnum].Title.Caption;
  end;
  Grid.DataSource.DataSet.First;
  RowNum:=3;
    for RecordNum := 1 to (Grid.DataSource.DataSet.RecordCount) do
    begin
    for ColNum:=0 to Grid.FieldCount-1 do
    ExcelWorkSheet1.Cells.Item[RowNum, colNum+1]:=Grid.Fields[colNum].Asstring;
    Grid.DataSource.DataSet.Next;
    RowNum := RowNum + 1;
    end;
  end;
  ExcelWorkBook1.SaveCopyAs(FileName);
  ExcelWorkBook1.Saved[0] :=true;
  ExcelWorksheet1.Free;
  ExcelWorkbook1.Free;
  ExcelApplication1.Free;
  ShowMessage('EXCEL文件输出完成！保存在"我的文档中",文件名为：'+FileName);
end;

Answer 2

a example:　　unit Unit1;
　　interface
　　uses
　　Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,olectnrs,
　　StdCtrls, Buttons, Grids, DBGrids, ExtCtrls, Db, DBTables,ComObj;
　　type
　　TMainForm = class(TForm)
　　DataSource1: TDataSource;
　　Table1: TTable;
　　Panel1: TPanel;
　　DBGrid1: TDBGrid;
　　Panel2: TPanel;
　　BitBtn1: TBitBtn;
　　BitBtn2: TBitBtn;
　　CheckBox1: TCheckBox;
　　procedure BitBtn2Click(Sender: TObject);
　　procedure BitBtn1Click(Sender: TObject);
　　procedure FormShow(Sender: TObject);
　　procedure FormClose(Sender: TObject; var Action: TCloseAction);
　　procedure FormCreate(Sender: TObject);
　　private
　　{ Private declarations }
　　public
　　{ Public declarations }
　　end;
　　var
　　MainForm: TMainForm;
　　implementation
　　{$R *.DFM}
　　procedure TMainForm.BitBtn2Click(Sender: TObject);begin
　　close;end;
　　procedure TMainForm.BitBtn1Click(Sender: T ect);var
　　v:variant;
　　s:string;
　　i,j:integer;begin
　　s:="c:\gz\example.xls"; //文件名
　　if fileexists(s) then deletefile(s);
　　v:=CreateOLEObject("Excel.Application"); //建立OLE对象
　　V.WorkBooks.Add;
　　if Checkbox1.Checked then
　　begin
　　V.Visible:=True;
　　MainForm.WindowState:=wsMinimized;
　　//使Excel可见，并将本程序最小化，以观察Excel的运行情况
　　end else
　　begin
　　V.Visible:=False;
　　end;
　　//使Excel窗口不可见
　　Application.BringToFront; //程序前置
　　try
　　try
　　Cursor:=crSQLWait;
　　Table1.DisableControls;
　　For i:=0 to Table1.FieldCount-1 do //字段数
　　//注意：Delphi中的数组的下标是从0开始的，
　　// 而Excel的表格是从1开始编号
　　begin
　　V.Goto("R1"+"C"+IntToStr(i+1)); //Excel的表格是从1开始编号
　　V.ActiveCell.FormulaR1C1:=Table1.Fields[i].FieldName;//传送字段名
　　end;
　　j:=2;
　　Table1.First;
　　while not Table1.EOF do
　　begin
　　For i:=0 to Table1.FieldCount-1 do //字段数
　　begin
　　V.Goto("R"+IntToStr(j)+"C"+IntToStr(i+1));
　　V.ActiveCell.FormulaR1C1:=Table1.Fields[i].AsString;//传送内容
　　end;
　　Table1.Next;
　　j:=j+1;
　　end;
　　V.ActiveSheet.Protect(DrawingObjects:=True, Contents:=True, Scenarios:=True);//设置保护
　　ShowMessage("数据库到Excel的数据传输完毕!"); 
　　v.ActiveWorkBook.Saveas(filename:=s);//文件存盘
　　except //发生错误时
　　ShowMessage("没有发现Excel!");
　　end;
　　finally
　　Cursor:=crDefault;
　　Table1.First;
　　Table1.EnableControls;
　　v.quit; //退出OLE对象
　　MainForm.WindowState:=wsNormal;
　　end;end;
　　procedure TMainForm.FormShow(Sender: TObject);begin
　　Table1.Open;end;
　　procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);begin
　　Table1.Close;end;
　　procedure TMainForm.FormCreate(Sender: TObject);var
　　sl:TStringList; {字符串列表变量}
　　i:Integer;begin
　　sl:=TStringlist.Create;
　　Session.GetAliasNames(sl); {取得别名列表}
　　if (sl.IndexOf("EXAMPLE")=-1) then {判断别名是否存在}
　　begin
　　i:=Application.MessageBox("别名EXAMPLE不存在，现在创建吗？","BDE信息窗口",mb_OKCancel);
　　{增加一个名为EXAMPLE的数据库别名}
　　if i=IDCANCEL then begin
　　sl.Free;
　　Application.Terminate; //程序终止
　　end;
　　Session.AddStandardAlias("EXAMPLE","C:\GZ","Paradox"); //增加别名
　　Session.SaveConfigFile; {BDE配置文件存盘}
　　end ;end;
　　end.