自己摸索的在DELPHI中把数据导到EXCEL中，就这么简单。

Question

这个问题一直困扰着我，在这里求救了N遍不是一些不痛不痒的就是太高深我根本不懂的。算了还是自己搞，翻了一些资料，自己搞成的，代码如下，很简单，基本上是一个示范。
 var i,j : integer;begin
    adoquery1.Open;  //连接数据库，这里只演示SQL我先写进去了
    ea1 := texcelapplication.Create(self);  //excelapplication1
    ew1 := texcelworkbook.Create(self);     //excelworkbook1
    ews1 := texcelworksheet.Create(self);   //excelworksheet1
    ea1.Connect;
    ea1.Workbooks.Add(null,0);
    ew1.ConnectTo(ea1.Workbooks[1]);
    ews1.ConnectTo(ew1.Sheets[1]as _worksheet);
    if adoquery1.RecordCount > 0 then    begin
        i:= 0;
        while not adoquery1.Eof
        do        begin
            for j:=0 to adoquery1.FieldCount-1
            do
            begin
            ews1.Cells.Item[i+1,j+1]:= adoquery1.Fields[j].AsString;
            end;
        i:= i+1;
        adoquery1.Next;
        end;
    end;
       ew1.SaveCopyAs('e:\temp.xls');//保存EXCEL这里你也可以自己写更多
       //最后注意这里要把excelapplication,excelworkbook,excelworksheet
       //关闭掉，怎么关？这个自己摸摸吧。不写的话要看到EXCEL表最好把机器注销一下
//这里只是一个示例你还可以在里面加入写表头的代码等其他功能。    end;抛砖引玉！请高手指点！

Answer 1

这是DBGRIDEH导出procedure Trenyuanxinxi.N7Click(Sender: TObject);
var
  ls_string:string;
begin
if saveDialog1.Execute then
   ls_string := saveDialog1.FileName;
 // ls_string:=ChooseFolder(handle,'请选择导出文件存放目录');
  if ls_string<>'' then
    begin
     ls_string:=ls_string+'.xls';
      SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,ls_string,true);
      application.messagebox(pchar(caption+'导出成功！'),'提示',mb_ok);
    end;
end;

Answer 2

这是一位高人的DBGRID导出
你可以试用一下：
http://www.starfarmsoft.com/exchange/ExcelCtrl.dcu函数定义为：
procedure SaveToExcel(ReptTitle, ReptHead: string; DataSet: TADOQuery; Grid: TDBGrid; FileName: string);需要说明的是：目前功能还比较简单，只对付一些常用的规则；DataSet是DBGrid的数据源(DBGrid.DataSource.DataSet=DataSet)，目前是多此一举，只是为以后方便！调用例如：
SaveToExcel('动力厂报表','excel表格',ADOQuery1,DBGrid1,'c:\动力厂报表.xls');在tools菜单----->Environment options--->library---->library path 加入'*.dcu'文件所在路径  
再在你的程序体里USES一下ExcelCtrl！

Answer 3

对excel的读写： 
unit UMain; interface uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
Db, DBTables, StdCtrls, Grids, DBGrids,Excel97,Comctrls,OleCtnrs,ComObj; type 
TForm1 = class(TForm) 
DBGrid1: TDBGrid; 
Button1: TButton; 
Button2: TButton; 
DataSource1: TDataSource; 
Table1: TTable; 
procedure Button1Click(Sender: TObject); 
procedure Button2Click(Sender: TObject); 
procedure FormClose(Sender: TObject; var Action: TCloseAction); 
private 
{ Private declarations } 
public 
XlsApp,XlsSheet,XlsWBk : Variant; 
{ Public declarations } 
end; var 
Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); 
var 
I,J : integer; 
begin 
if VarIsEmpty(XlsApp) then 
XlsApp := CreateOleObject('Excel.Application'); XLsApp.Workbooks.Add; 
XlsSheet := XLsApp.Worksheets['Sheet1']; for I := 0 to Table1.Fields.Count - 1 do 
begin 
XlsSheet.Cells[3,I + 1] := dbgrid1.Columns[I].Title.Caption; 
end; Table1.first; 
for J := 0 to Table1.RecordCount - 1 do 
begin 
for I := 0 to Table1.Fields.Count - 1 do 
begin 
XlsSheet.Cells[J + 4,I + 1] := Table1.Fields[I].AsString; 
end; 
Table1.Next; 
end; XlsApp.Visible := true; 
end; procedure TForm1.Button2Click(Sender: TObject); 
var 
I,J : integer; 
TxtFile : TextFile; 
TmpString : String; 
begin 
try 
if VarIsEmpty(XlsApp) then 
XlsApp := CreateOleObject('Excel.Application'); 
XlsSheet := XlsApp.workbooks.open('c:\my documents\book3.xls'); AssignFile(TxtFile,'C:\My Documents\Test.txt'); 
Rewrite(TxtFile); 
try 
for I := 3 to 21 do 
begin 
TmpString := ''; 
for J := 1 to 5 do 
begin 
TmpString := TmpString + XlsSheet.ActiveSheet.Cells[I,J].Text + '|'; 
end; 
Writeln(TxtFile,Tmpstring); 
end; 
finally 
CloseFile(TxtFile); 
end; 
XlsApp.Visible := true; 
except 
XlsSheet.close; 
XlsApp.Application.quit; 
XlsApp := Unassigned; 
XlsSheet := Unassigned; 
end; 
end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
if not VarIsEmpty(XlsApp) then 
begin 
XlsApp.DisplayAlerts := True; // 7Discard unsaved files.... 
try 
XlsApp.Application.Quit; 
except 
end; 
end; 
end; end. 

Answer 4

请问楼主ea1   ew1   ews1，三个变量要定义吗；
variant??为什么我的这里出错？
    ea1 := texcelapplication.Create(self);  //excelapplication1
    ew1 := texcelworkbook.Create(self);     //excelworkbook1
    ews1 := texcelworksheet.Create(self);   //excelworksheet1
谢谢

Answer 5

抛砖引玉一下，还望指正function ExportStudentInfo(AQry: TADOQuery; AExcelFile: string) :integer ;
var
  EclApp : Variant;
Begin
  Result := -1 ;
  try
    EclApp := CreateOleObject('Excel.Application');
  except
    Exit;
  end;  if not Assigned(frmWaiting) then
    frmWaiting := TfrmWaiting.Create(Application) ;
  try
    frmWaiting.show ;
    frmWaiting.LabelGroup.Visible := true ;
    frmWaiting.LabelNow.Caption := '正在导出考生数据' ;
    frmWaiting.LabelNow.Visible := true ;
    frmWaiting.LabelCount.Visible := true ;
    frmWaiting.pb.Visible := true ;
    frmWaiting.Update ;    try
      EclApp.WorkBooks.Add ;
      EclApp.ActiveWorkBook.Saved:=True;
      EclApp.WorkSheets[1].Activate;
      EclApp.Cells.Font.Name := 'Arial' ;
      EclApp.Cells.Font.Color := clBlack ;
      EclApp.Cells.Font.Size := 9 ;
      EclApp.Cells.Font.Bold := false ;
      EclApp.Cells.Font.UnderLine := false ;
      EclApp.Visible := false ;
      EclApp.Cells.Select;
      EclApp.Selection.NumberFormatLocal := '@';         //保证为文本格式//      StudentDataSetQuickToSheet(EclApp.Activesheet, AQry) ;
      StudentDataSetToSheet(EclApp.Activesheet, AQry) ;      EclApp.ActiveWorkBook.SaveAs(AExcelFile);
      Result := 1 ;
    except on E :Exception do
      begin
        frmWaiting.Hide ;
        MyMsgBox(pChar('导出考生数据过程中出错，请检查后再试！' + #13#10 + #13#10 + '具体原因为：' + E.Message), MB_OK + MB_ICONINFORMATION) ;
        Result := 0 ;
      end ;
    end;
  finally
    frmWaiting.Release ;
    frmWaiting := nil ;
    EclApp.ActiveWorkBook.Saved:=True;
    EclApp.ActiveWorkBook.Close;
    eclApp.Quit; {释放VARIANT变量}
    eclApp:=Unassigned;
  end;
end;

Answer 6

procedure StudentDataSetQuickToSheet(ASheet :Variant; AQry :TADOQuery) ;
var
  Row : Integer ;
  sStr :string ;
  tsList  :TStringList;
  i :integer ;
  LastColLetter :string ;
begin
  ASheet.Rows.RowHeight := 15;
  ASheet.Columns.ColumnWidth := 10 ;  ASheet.Rows[1].Font.Name := 'Arial';
  ASheet.Rows[1].Font.Color := clBlack;
  ASheet.Rows[1].Font.Size := 9 ;
  ASheet.Rows[1].Font.Bold := True;
  ASheet.Rows[1].Font.UnderLine := false;  LastColLetter := trim(Copy(SORTEDLETTER, High(STUDENTINFO) - Low(STUDENTINFO) + 1, 1)) ;
  sStr := 'A1:' + LastColLetter + '1' ;
  ASheet.Range[sStr].Columns.Interior.Color := clYellow;  tsList := TStringList.Create ;
  tsList.Clear ;
  try
    sStr := '' ;
    for i := Low(STUDENTINFO) to High(STUDENTINFO) do
    begin
      sStr := sStr + STUDENTINFO[i, 2] + #9 ;
    end ;
    tsList.Add(sStr) ;    frmWaiting.pb.MaxValue := AQry.RecordCount ;
    frmWaiting.pb.Progress := 0 ;
    frmWaiting.LabelCount.Caption := '还剩' + IntToStr(AQry.RecordCount) + '条记录' ;
    frmWaiting.Update ;
    Row := 2 ;
    with AQry do
    begin
      First ;
      while not Eof do
      begin
        Application.ProcessMessages ;        frmWaiting.LabelNow.Caption := '正在导出数据：准考证号（' + FieldByName('Code').asstring + '）' ;
        frmWaiting.pb.Progress := frmWaiting.pb.Progress + 1 ;
        frmWaiting.LabelCount.Caption := '还剩' + IntToStr(RecordCount - frmWaiting.pb.Progress) + '条记录' ;
        frmWaiting.Update ;        sStr := '' ;
        for i := Low(STUDENTINFO) to High(STUDENTINFO) do
        begin
          sStr := sStr + FieldByName(STUDENTINFO[i, 1]).AsString + #9 ;
        end ;
        tsList.Add(sStr);        Next ;
        Inc(Row) ;
      end ;
    end;
    Clipboard.AsText:=tsList.Text;
    frmWaiting.LabelNow.Caption := '正在生成当前工作表...' ;
    frmWaiting.LabelCount.Caption := '该操作可能需要几分钟，请稍候...';
    frmWaiting.Update ;    ASheet.Paste ;    sStr := 'A1:' + LastColLetter + IntToStr(Row - 1) ;
    ASheet.Range[sStr].Borders.Color := clBlack ;    sStr := 'A2:' + LastColLetter + IntToStr(Row - 1) ;
    ASheet.Range[sStr].Columns.Interior.Color := $009FC8FF; //clOlive;
  finally
    tsList.Clear ;
    tsList.Free ;
  end ;
end ;
注：      STUDENTINFO :array[1..5, 1..2] of string = (('CODE', '准考证号'), ('NAME', '姓名'), ('PASSWD', '密码'),
                                                  ('CLASS', '班级'), ('MEMO', '备注')) ;

Answer 7

procedure StudentDataSetToSheet(ASheet :Variant; AQry :TADOQuery) ;
var
  Row : Integer ;
  sStr :string ;
  LastColLetter :string ;
  i :integer ;
begin
  ASheet.Rows.RowHeight := 15;
  ASheet.Columns.ColumnWidth := 10 ;
//  ASheet.Columns.EntireColumn.AutoFit;  ASheet.Rows[1].Font.Name := 'Arial';
  ASheet.Rows[1].Font.Color := clBlack;
  ASheet.Rows[1].Font.Size := 9 ;
  ASheet.Rows[1].Font.Bold := True;
  ASheet.Rows[1].Font.UnderLine := false;  LastColLetter := trim(Copy(SORTEDLETTER, High(STUDENTINFO) - Low(STUDENTINFO) + 1, 1)) ;
  sStr := 'A1:' + LastColLetter + '1' ;
  ASheet.Range[sStr].Columns.Interior.Color := clYellow;  for i := Low(STUDENTINFO) to High(STUDENTINFO) do
  begin
    ASheet.Cells(1, i) := STUDENTINFO[i, 2] ;
  end ;  frmWaiting.pb.MaxValue := AQry.RecordCount ;
  frmWaiting.pb.Progress := 0 ;
  frmWaiting.LabelCount.Caption := '还剩' + IntToStr(AQry.RecordCount) + '条记录' ;
  frmWaiting.Update ;
  Row := 2 ;
  with AQry do
  begin
    First ;
    while not Eof do
    begin
      Application.ProcessMessages ;      frmWaiting.LabelNow.Caption := '正在导出数据：准考证号（' + FieldByName('Code').asstring + '）' ;
      frmWaiting.pb.Progress := frmWaiting.pb.Progress + 1 ;
      frmWaiting.LabelCount.Caption := '还剩' + IntToStr(RecordCount - frmWaiting.pb.Progress) + '条记录' ;
      frmWaiting.Update ;      //added by czf 020910
      if frmWaiting.pb.Progress mod 500 = 0 then
      begin
        RefreshQuery(AQry, true, true) ;
      end ;
      //added by czf 020910 --end      for i := Low(STUDENTINFO) to High(STUDENTINFO) do
      begin
        ASheet.Cells(Row, i) := FieldByName(STUDENTINFO[i, 1]).asstring ;
      end ;      Next ;
      Inc(Row) ;
    end ;
  end;
  sStr := 'A1:' + LastColLetter + IntToStr(Row - 1) ;
  ASheet.Range[sStr].Borders.Color := clBlack ;  sStr := 'A2:' + LastColLetter + IntToStr(Row - 1) ;
  ASheet.Range[sStr].Columns.Interior.Color := $009FC8FF; //clOlive;
end ;

Answer 8

TO yetti(yetti) 
你在FORM上把3个控件放上去，不需要定义的。

Answer 9

来个简单的，
  SELECT * into sheet1 FROM Tab1 IN [ODBC]
  [ODBC;Driver=SQL Server;UID=sa;PWD=;Server=127.0.0.1;DataBase=Demo;]
就一句就行了，呵呵

Answer 10

楼上用一行sql导到excel的我在delphibbs看到过但是我没试出来，如果你会能详细讲讲吗？

Answer 11

能不能一次就能写入一条记录到excel中，而不是一格一格的写入？

Answer 12

看看我的：
http://expert.csdn.net/Expert/TopicView1.asp?id=1909498