哪位能帮助写一个Access数据转变成Excel格式的程序，通用的，给50分 急急急

Question

哪位能帮助写一个Access数据转变成Excel格式的程序，本人想学这方面的知识。急急急

Answer 1

function toxsl(ado:Tadoquery;grid:TDbgrid;fn:string):Boolean;
var
  i,row:integer;
  eclapp,WorkBook,sheet:Variant;
begin
  try
    //创建OLE对象Excel Application与 WorkBook
        eclApp:=CreateOleObject('Excel.Application');
        WorkBook:=CreateOleobject('Excel.Sheet');
    except
        Application.MessageBox('您的电脑里未安装Microsoft Excel 2000!'+'错误提示',0);
        Exit;
    end;
 application.ProcessMessages;
 Sheet:= WorkBook.ActiveSheet;
 Sheet.Cells.Font.Name:='宋体';//字体
 Sheet.Cells.Font.Size:=9;//字号
 Sheet.Cells.VerticalAlignment:=1;
 for i:=1 to 16 do
   begin
     Sheet.Columns[i].NumberFormat:='@';
     Sheet.Cells[1,i]:=grid.Columns[i-1].Title.Caption;
     sheet.cells[1,i].Font.Bold:=True;
   end;
 try
 ado.First;
 row:=2;
 while not ado.Eof do
   begin
     for i:=1 to 16 do
       Sheet.Cells[row,i]:=ado.FieldByName(grid.Columns[i-1].FieldName).AsString;
     row:=row+1;
     ado.Next;
   end;
     workBook.saveas(fn);
     WorkBook.Close;
     eclApp.Quit;
        //退出Excel Application
        //释放VARIANT变量
      eclApp:=Unassigned;
      application.MessageBox('已经成功生成EXCEL文件 !','提示',0);
    except
        application.MessageBox('不能正确操作Excel文件!'+chr(13)+'可能是该文件已被其他程序打开, 或系统错误 !'+chr(13),'错误提示',0);
        WorkBook.close;
        eclApp.Quit;
        //释放VARIANT变量
        eclApp:=Unassigned;
    end;
end;

Answer 2

用AdoQuery查询出来：
with AdoQuery1 do
begin
  Close;
  Sql.Clear;
  Sql.Add('select * from table1');
  Open;
end;
然后调用如下过程即可：
procedure ExportToExcel(ADOQry: TADOQuery);
var
  MyExcel: Variant;
  WorkBook: OleVariant;
  WorkSheet: OleVariant;
  i,j:integer;
begin
  try
   MyExcel:=CreateOleObject('Excel.Application');
   MyExcel.Application.WorkBooks.Add;
   MyExcel.Caption:='将数据导入到EXCEL表中';
   MyExcel.Application.Visible:=true;
   WorkBook:=MyExcel.Application.workbooks[1];
   worksheet:=workbook.worksheets.item[1];
   except
    showmessage('EXCEL不存在！');
   end;
   i:=1;  with ADOQry do
  begin
    for j:=0 to FieldCount-1 do worksheet.cells[1,j+1]:=Fields[j].FieldName;
    First;
    while not Eof do
    begin
      inc(i);
      for j:=0 to fieldcount-1 do
      begin
        worksheet.cells[i,j+1].NumberFormatLocal :='@';
        worksheet.cells[i,j+1].Borders.LineStyle:=1;
        worksheet.cells[i,j+1]:=Fields[j].asstring;
      end;
      next;
    end;
  end;
end;